Connect two macros...how?
Connect two macros...how?
(OP)
Hello. I create two macros.First identify selected surface and give some information about it and second macro identify selected line and give some information about it.So I want connect this macros in one that if I select surface then identify it give information about it and give information about it boundary line(macro identity line). How I can make something like that???I work with API SolidWorks not so long and I dont have any ideas for this problem.If You have please answer.
First macro:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFace As SldWorks.Face2
Dim swSurf As SldWorks.Surface
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As SldWorks.Feature
Dim MathPoint As SldWorks.MathPoint
Dim RefPoint As SldWorks.RefPoint
Dim vRefPointFeatureArray As Variant
Dim XYZ As Variant
Dim vPlane As Variant
Dim vCylinder As Variant
Dim vCone As Variant
Dim vTorus As Variant
Dim vSphere As Variant
Dim vBsurf As Variant
Dim vRefPoint As Variant
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFace = swSelMgr.GetSelectedObject5(1)
If swSelMgr.GetSelectedObjectCount <> 1 Then
swApp.SendMsgToUser " Please select ONE Surface to identify "
GoTo CleanUp
End If
Set swSurf = swFace.GetSurface
vRefPointFeatureArray = swModel.FeatureManager.InsertReferencePoint(4, 0, 0.01, 1)
Set Feature = vRefPointFeatureArray(0)
Set RefPoint = Feature.GetSpecificFeature2
Set MathPoint = RefPoint.GetRefPoint
XYZ = MathPoint.ArrayData
Set MathPoint = Nothing
Set RefPoint = Nothing
Set Feature = Nothing
swApp.SendMsgToUser " Center of selected surface: " _
& vbCrLf _
& vbCrLf & " X = " & XYZ(0) * 1000 & " mm" _
& vbCrLf & " Y = " & XYZ(1) * 1000 & " mm" _
& vbCrLf & " Z = " & XYZ(2) * 1000 & " mm"
If swSurf.IsPlane Then
vPlane = swSurf.PlaneParams
swApp.SendMsgToUser " Selected Surface - PLANE " _
& vbCrLf & vbCrLf & " Normal = (" & vPlane(0) & ", " & vPlane(1) & ", " & vPlane(2) & ")" _
& vbCrLf & vbCrLf & " Root = (" & vPlane(3) * 1000# & ", " & vPlane(4) * 1000# & ", " & vPlane(5) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
GoTo CleanUp
End If
If swSurf.IsCylinder Then
vCylinder = swSurf.CylinderParams
swApp.SendMsgToUser " Selected Surface - CYLINDER " _
& vbCrLf & vbCrLf & " Radius = " & vCylinder(6) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Axis = (" & vCylinder(3) & ", " & vCylinder(4) & ", " & vCylinder(5) & ")" _
& vbCrLf & vbCrLf & " Origin = (" & vCylinder(0) * 1000# & ", " & vCylinder(1) * 1000# & ", " & vCylinder(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
GoTo CleanUp
End If
If swSurf.IsCone Then
vCone = swSurf.ConeParams
swApp.SendMsgToUser " Selected Surface - CONE " _
& vbCrLf & vbCrLf & " Radius = " & vCone(6) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Half angle = " & vCone(7) * 57.3 & " degrees" _
& vbCrLf & vbCrLf & " Axis = (" & vCone(3) & ", " & vCone(4) & ", " & vCone(5) & ")" _
& vbCrLf & vbCrLf & " Origin = (" & vCone(0) * 1000# & ", " & vCone(1) * 1000# & ", " & vCone(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
GoTo CleanUp
End If
If swSurf.IsTorus Then
vTorus = swSurf.TorusParams
swApp.SendMsgToUser " Selected Surface - TORUS " _
& vbCrLf & vbCrLf & " Distance betwen center of torus and center of revolved circle = " & vTorus(7) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Radius of revolved circle = " & vTorus(6) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Center = (" & vTorus(0) * 1000# & ", " & vTorus(1) * 1000# & ", " & vTorus(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " Axis = (" & vTorus(3) & ", " & vTorus(4) & ", " & vTorus(5) & ")" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName _
& vbCrLf & vbCrLf & " Major Radius of the torus = " & vTorus(6) * 1000# + vTorus(7) * 1000# & " mm ???"
GoTo CleanUp
End If
If swSurf.IsSphere Then
vSphere = swSurf.SphereParams
swApp.SendMsgToUser " Selected Surface - SPHERE " _
& vbCrLf & vbCrLf & " Center = (" & vSphere(0) * 1000# & ", " & vSphere(1) * 1000# & ", " & vSphere(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " Radius = " & vSphere(3) * 1000 & " mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
GoTo CleanUp
End If
If swSurf.IsBlending Then
swApp.SendMsgToUser " Selected Surface - BLEND "
GoTo CleanUp
End If
If swSurf.IsSwept Then
swApp.SendMsgToUser " Selected Surface - SWEPT "
GoTo CleanUp
End If
If swSurf.IsRevolved Then
swApp.SendMsgToUser " Selected Surface - REVOLVED "
GoTo CleanUp
End If
If swSurf.IsForeign Then
swApp.SendMsgToUser " Selected Surface - FOREIGN "
GoTo CleanUp
End If
If swSurf.IsOffset Then
swApp.SendMsgToUser " Selected Surface - OFFSET "
GoTo CleanUp
End If
If swSurf.IsParametric Then
swApp.SendMsgToUser " Selected Surafce - B-SPLINE SURFACE "
GoTo CleanUp
End If
CleanUp:
Set swFace = Nothing
Set swSurf = Nothing
Set swSelMgr = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub
Second Macro:
Option Explicit
Const dPi = 3.141592654
Const MtoMM = 1000
Const M2toMM2 = 1000000
Const swSelEDGES = 1
Const swMbInformation = 2
Const swMbStop = 4
Const swMbOk = 2
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swSelMgr As SelectionMgr
Dim swEdge As Edge
Dim swCurve As Curve
Dim lngSelType As Long
Dim pt1 As Double
Dim pt2 As Double
Dim vpoint1 As Variant
Dim bVal1 As Boolean
Dim bVal2 As Boolean
Dim vSafeArray As Variant
Dim dLen As Double
Dim vParams As Variant
Sub main()
Dim sMsg As String
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
If swSelMgr.GetSelectedObjectCount <> 1 Then
swApp.SendMsgToUser2 "Please Select ONE Edge to Measure", swMbStop, swMbOk
GoTo CleanUp
End If
lngSelType = swSelMgr.GetSelectedObjectType2(1)
If lngSelType = swSelEDGES Then
Set swEdge = swSelMgr.GetSelectedObject3(1)
Set swCurve = swEdge.GetCurve
If swCurve.IsLine Then
Call swCurve.GetEndParams(pt1, pt2, bVal1, bVal2)
dLen = swCurve.GetLength2(pt1, pt2)
vParams = swEdge.GetCurveParams
sMsg = "Selected Edge - Line" & vbCrLf & vbCrLf & _
"Length = " & Format(dLen * MtoMM, "###,##0.000") & " mm" _
& vbCrLf & "Coordinates End Point1 : (" & Format(vParams(0) * 1000, "##,##0.000") & ", " _
& Format(vParams(1) * 1000, "##,##0.000") & ", " _
& Format(vParams(2) * 1000, "##,##0.000") & ")" & "" _
& vbCrLf & "Coordinates End Point2 : (" & Format(vParams(3) * 1000, "##,##0.000") & ", " _
& Format(vParams(4) * 1000, "##,##0.000") & ", " _
& Format(vParams(5) * 1000, "##,##0.000") & ")" & "" _
& vbCrLf & "Start Point = " & Format(vParams(6) * 1000, "##,##0.000") & " mm" _
& vbCrLf & "End Point = " & Format(vParams(7) * 1000, "##,##0.000") & " mm"
End If
If swCurve.IsCircle Then
vSafeArray = swCurve.CircleParams
sMsg = "Selected Edge - Circle" & vbCrLf & vbCrLf & _
"Center : (" & Format(vSafeArray(0) * MtoMM, "##,##0.000") & _
", " & Format(vSafeArray(1) * MtoMM, "##,##0.000") & _
", " & Format(vSafeArray(2) * MtoMM, "##,##0.000") & ")" & " (mm)" & vbCrLf & _
"Diameter = " & Format(vSafeArray(6) * 2 * MtoMM, "##,##0.000") & " mm" & vbCrLf & _
"Circumference = " & Format(2 * dPi * vSafeArray(6) * MtoMM, "##,##0.000") & " mm" & vbCrLf & _
"Area = " & Format(dPi * vSafeArray(6) ^ 2 * M2toMM2, "##,##0.000") & " mm²"
End If
If swCurve.IsBcurve Then
Call swCurve.GetEndParams(pt1, pt2, bVal1, bVal2)
dLen = swCurve.GetLength2(pt1, pt2)
vParams = swEdge.GetCurveParams
sMsg = "Selected Edge - Bcurve" & vbCrLf & vbCrLf & _
"Length = " & Format(dLen * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & "Coordinates End Point1 : (" & Format(vParams(0) * 1000, "##,##0.000") & " , " _
& Format(vParams(1) * 1000, "##,##0.000") & " , " _
& Format(vParams(2) * 1000, "##,##0.000") & ")" & "" _
& vbCrLf & "Coordinates End Point2 : (" & Format(vParams(3) * 1000, "##,##0.000") & " , " _
& Format(vParams(4) * 1000, "##,##0.000") & " , " _
& Format(vParams(5) * 1000, "##,##0.000") & ")" & ""
End If
If swCurve.IsEllipse Then
vSafeArray = swCurve.GetEllipseParams
sMsg = "Selected Edge - Ellipse" & vbCrLf & vbCrLf & _
"Center of ellipse : " _
& vbCrLf & " X = " & Format(vSafeArray(0) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & " Y = " & Format(vSafeArray(1) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & " Z = " & Format(vSafeArray(2) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & vbCrLf & "Major Radius = " & Format(vSafeArray(3) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & "Minor Radius = " & Format(vSafeArray(7) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & "Area = " & Format(dPi * vSafeArray(3) * 2 * vSafeArray(7) * 2 * M2toMM2, "##,##0.000") & " mm²" _
& vbCrLf & "Circumference ??? = " & Format(dPi * (3 * ((2 * vSafeArray(3) + 2 * vSafeArray(7)) / 2 - (2 * vSafeArray(3) * 2 * vSafeArray(7)) ^ 0.5) * MtoMM), "##,##0.000" & " mm")
End If
Else
swApp.SendMsgToUser2 "I can only measure Edges", swMbStop, swMbOk
End If
swApp.SendMsgToUser2 sMsg, swMbInformation, swMbOk
CleanUp:
Set swEdge = Nothing
Set swCurve = Nothing
Set swSelMgr = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub
First macro:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFace As SldWorks.Face2
Dim swSurf As SldWorks.Surface
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As SldWorks.Feature
Dim MathPoint As SldWorks.MathPoint
Dim RefPoint As SldWorks.RefPoint
Dim vRefPointFeatureArray As Variant
Dim XYZ As Variant
Dim vPlane As Variant
Dim vCylinder As Variant
Dim vCone As Variant
Dim vTorus As Variant
Dim vSphere As Variant
Dim vBsurf As Variant
Dim vRefPoint As Variant
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFace = swSelMgr.GetSelectedObject5(1)
If swSelMgr.GetSelectedObjectCount <> 1 Then
swApp.SendMsgToUser " Please select ONE Surface to identify "
GoTo CleanUp
End If
Set swSurf = swFace.GetSurface
vRefPointFeatureArray = swModel.FeatureManager.InsertReferencePoint(4, 0, 0.01, 1)
Set Feature = vRefPointFeatureArray(0)
Set RefPoint = Feature.GetSpecificFeature2
Set MathPoint = RefPoint.GetRefPoint
XYZ = MathPoint.ArrayData
Set MathPoint = Nothing
Set RefPoint = Nothing
Set Feature = Nothing
swApp.SendMsgToUser " Center of selected surface: " _
& vbCrLf _
& vbCrLf & " X = " & XYZ(0) * 1000 & " mm" _
& vbCrLf & " Y = " & XYZ(1) * 1000 & " mm" _
& vbCrLf & " Z = " & XYZ(2) * 1000 & " mm"
If swSurf.IsPlane Then
vPlane = swSurf.PlaneParams
swApp.SendMsgToUser " Selected Surface - PLANE " _
& vbCrLf & vbCrLf & " Normal = (" & vPlane(0) & ", " & vPlane(1) & ", " & vPlane(2) & ")" _
& vbCrLf & vbCrLf & " Root = (" & vPlane(3) * 1000# & ", " & vPlane(4) * 1000# & ", " & vPlane(5) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
GoTo CleanUp
End If
If swSurf.IsCylinder Then
vCylinder = swSurf.CylinderParams
swApp.SendMsgToUser " Selected Surface - CYLINDER " _
& vbCrLf & vbCrLf & " Radius = " & vCylinder(6) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Axis = (" & vCylinder(3) & ", " & vCylinder(4) & ", " & vCylinder(5) & ")" _
& vbCrLf & vbCrLf & " Origin = (" & vCylinder(0) * 1000# & ", " & vCylinder(1) * 1000# & ", " & vCylinder(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
GoTo CleanUp
End If
If swSurf.IsCone Then
vCone = swSurf.ConeParams
swApp.SendMsgToUser " Selected Surface - CONE " _
& vbCrLf & vbCrLf & " Radius = " & vCone(6) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Half angle = " & vCone(7) * 57.3 & " degrees" _
& vbCrLf & vbCrLf & " Axis = (" & vCone(3) & ", " & vCone(4) & ", " & vCone(5) & ")" _
& vbCrLf & vbCrLf & " Origin = (" & vCone(0) * 1000# & ", " & vCone(1) * 1000# & ", " & vCone(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
GoTo CleanUp
End If
If swSurf.IsTorus Then
vTorus = swSurf.TorusParams
swApp.SendMsgToUser " Selected Surface - TORUS " _
& vbCrLf & vbCrLf & " Distance betwen center of torus and center of revolved circle = " & vTorus(7) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Radius of revolved circle = " & vTorus(6) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Center = (" & vTorus(0) * 1000# & ", " & vTorus(1) * 1000# & ", " & vTorus(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " Axis = (" & vTorus(3) & ", " & vTorus(4) & ", " & vTorus(5) & ")" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName _
& vbCrLf & vbCrLf & " Major Radius of the torus = " & vTorus(6) * 1000# + vTorus(7) * 1000# & " mm ???"
GoTo CleanUp
End If
If swSurf.IsSphere Then
vSphere = swSurf.SphereParams
swApp.SendMsgToUser " Selected Surface - SPHERE " _
& vbCrLf & vbCrLf & " Center = (" & vSphere(0) * 1000# & ", " & vSphere(1) * 1000# & ", " & vSphere(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " Radius = " & vSphere(3) * 1000 & " mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
GoTo CleanUp
End If
If swSurf.IsBlending Then
swApp.SendMsgToUser " Selected Surface - BLEND "
GoTo CleanUp
End If
If swSurf.IsSwept Then
swApp.SendMsgToUser " Selected Surface - SWEPT "
GoTo CleanUp
End If
If swSurf.IsRevolved Then
swApp.SendMsgToUser " Selected Surface - REVOLVED "
GoTo CleanUp
End If
If swSurf.IsForeign Then
swApp.SendMsgToUser " Selected Surface - FOREIGN "
GoTo CleanUp
End If
If swSurf.IsOffset Then
swApp.SendMsgToUser " Selected Surface - OFFSET "
GoTo CleanUp
End If
If swSurf.IsParametric Then
swApp.SendMsgToUser " Selected Surafce - B-SPLINE SURFACE "
GoTo CleanUp
End If
CleanUp:
Set swFace = Nothing
Set swSurf = Nothing
Set swSelMgr = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub
Second Macro:
Option Explicit
Const dPi = 3.141592654
Const MtoMM = 1000
Const M2toMM2 = 1000000
Const swSelEDGES = 1
Const swMbInformation = 2
Const swMbStop = 4
Const swMbOk = 2
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swSelMgr As SelectionMgr
Dim swEdge As Edge
Dim swCurve As Curve
Dim lngSelType As Long
Dim pt1 As Double
Dim pt2 As Double
Dim vpoint1 As Variant
Dim bVal1 As Boolean
Dim bVal2 As Boolean
Dim vSafeArray As Variant
Dim dLen As Double
Dim vParams As Variant
Sub main()
Dim sMsg As String
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
If swSelMgr.GetSelectedObjectCount <> 1 Then
swApp.SendMsgToUser2 "Please Select ONE Edge to Measure", swMbStop, swMbOk
GoTo CleanUp
End If
lngSelType = swSelMgr.GetSelectedObjectType2(1)
If lngSelType = swSelEDGES Then
Set swEdge = swSelMgr.GetSelectedObject3(1)
Set swCurve = swEdge.GetCurve
If swCurve.IsLine Then
Call swCurve.GetEndParams(pt1, pt2, bVal1, bVal2)
dLen = swCurve.GetLength2(pt1, pt2)
vParams = swEdge.GetCurveParams
sMsg = "Selected Edge - Line" & vbCrLf & vbCrLf & _
"Length = " & Format(dLen * MtoMM, "###,##0.000") & " mm" _
& vbCrLf & "Coordinates End Point1 : (" & Format(vParams(0) * 1000, "##,##0.000") & ", " _
& Format(vParams(1) * 1000, "##,##0.000") & ", " _
& Format(vParams(2) * 1000, "##,##0.000") & ")" & "" _
& vbCrLf & "Coordinates End Point2 : (" & Format(vParams(3) * 1000, "##,##0.000") & ", " _
& Format(vParams(4) * 1000, "##,##0.000") & ", " _
& Format(vParams(5) * 1000, "##,##0.000") & ")" & "" _
& vbCrLf & "Start Point = " & Format(vParams(6) * 1000, "##,##0.000") & " mm" _
& vbCrLf & "End Point = " & Format(vParams(7) * 1000, "##,##0.000") & " mm"
End If
If swCurve.IsCircle Then
vSafeArray = swCurve.CircleParams
sMsg = "Selected Edge - Circle" & vbCrLf & vbCrLf & _
"Center : (" & Format(vSafeArray(0) * MtoMM, "##,##0.000") & _
", " & Format(vSafeArray(1) * MtoMM, "##,##0.000") & _
", " & Format(vSafeArray(2) * MtoMM, "##,##0.000") & ")" & " (mm)" & vbCrLf & _
"Diameter = " & Format(vSafeArray(6) * 2 * MtoMM, "##,##0.000") & " mm" & vbCrLf & _
"Circumference = " & Format(2 * dPi * vSafeArray(6) * MtoMM, "##,##0.000") & " mm" & vbCrLf & _
"Area = " & Format(dPi * vSafeArray(6) ^ 2 * M2toMM2, "##,##0.000") & " mm²"
End If
If swCurve.IsBcurve Then
Call swCurve.GetEndParams(pt1, pt2, bVal1, bVal2)
dLen = swCurve.GetLength2(pt1, pt2)
vParams = swEdge.GetCurveParams
sMsg = "Selected Edge - Bcurve" & vbCrLf & vbCrLf & _
"Length = " & Format(dLen * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & "Coordinates End Point1 : (" & Format(vParams(0) * 1000, "##,##0.000") & " , " _
& Format(vParams(1) * 1000, "##,##0.000") & " , " _
& Format(vParams(2) * 1000, "##,##0.000") & ")" & "" _
& vbCrLf & "Coordinates End Point2 : (" & Format(vParams(3) * 1000, "##,##0.000") & " , " _
& Format(vParams(4) * 1000, "##,##0.000") & " , " _
& Format(vParams(5) * 1000, "##,##0.000") & ")" & ""
End If
If swCurve.IsEllipse Then
vSafeArray = swCurve.GetEllipseParams
sMsg = "Selected Edge - Ellipse" & vbCrLf & vbCrLf & _
"Center of ellipse : " _
& vbCrLf & " X = " & Format(vSafeArray(0) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & " Y = " & Format(vSafeArray(1) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & " Z = " & Format(vSafeArray(2) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & vbCrLf & "Major Radius = " & Format(vSafeArray(3) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & "Minor Radius = " & Format(vSafeArray(7) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & "Area = " & Format(dPi * vSafeArray(3) * 2 * vSafeArray(7) * 2 * M2toMM2, "##,##0.000") & " mm²" _
& vbCrLf & "Circumference ??? = " & Format(dPi * (3 * ((2 * vSafeArray(3) + 2 * vSafeArray(7)) / 2 - (2 * vSafeArray(3) * 2 * vSafeArray(7)) ^ 0.5) * MtoMM), "##,##0.000" & " mm")
End If
Else
swApp.SendMsgToUser2 "I can only measure Edges", swMbStop, swMbOk
End If
swApp.SendMsgToUser2 sMsg, swMbInformation, swMbOk
CleanUp:
Set swEdge = Nothing
Set swCurve = Nothing
Set swSelMgr = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub






RE: Connect two macros...how?
RE: Connect two macros...how?
Do yourself and the next programmer a big favor: break your macro up into smaller subroutines and functions. I would probably write separate subs or functions to 1.) verify proper selection and determine selected object type; 2.) get object information; 3.) display information 4.) clean up.
Good job adding "Cleanup" steps to your program. Very important to release objects (set objects to "Nothing"). I usually put cleanup commands into a subroutine and call at the end.
Instead of message box, I would display information on a form and allow user to copy data to paste elsewhere.
http://www.EsoxRepublic.com-SolidWorks API VB programming help
RE: Connect two macros...how?
Picia:
What you need to do is copy macro # 2 into the same macro file as #1. Instead of "main()", macro # 2 should be something like "myEdgeData(swEdge as SldWorks.Edge)". What you will do is call the second macro from the first, passing it a reference to each edge bounding the face. You can do this by placing some code like this toward the end of macro # 1
dim myEdges() as variant
dim i as long
myEdges = swFace.getedges
for i = 0 to swface.getedgecount-1
call myEdgeData(myEdges(i))
next i
You will have to remove all the code from macro #2 that gets the selected edge, since the edge will be passed by macro #1.
RE: Connect two macros...how?
I would like something like that what wrote handleman.oh, handleman thanks for your help.I place this code to the end of macro 1, copy code from macro and if I want run i have a error: Type of argumet ByRef incopatibility. And myEdges(i) is highlighted...
Dim myEdges As Variant
Dim i As Long
myEdges = swFace.GetEdges
For i = 0 To swFace.GetEdgeCount - 1
Call myEdgeData(myEdges(i))
Next i
End Sub
Sub myEdgeData(swEdge As SldWorks.Edge)
RE: Connect two macros...how?
Enjoy!
CODE
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFace As SldWorks.Face2
Dim swSurf As SldWorks.Surface
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As SldWorks.Feature
Dim MathPoint As SldWorks.MathPoint
Dim RefPoint As SldWorks.RefPoint
Dim vRefPointFeatureArray As Variant
Dim XYZ As Variant
Dim vPlane As Variant
Dim vCylinder As Variant
Dim vCone As Variant
Dim vTorus As Variant
Dim vSphere As Variant
Dim vBsurf As Variant
Dim vRefPoint As Variant
Dim myEdges As Variant
Dim i As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFace = swSelMgr.GetSelectedObject5(1)
If swSelMgr.GetSelectedObjectCount <> 1 Then
swApp.SendMsgToUser " Please select ONE Surface to identify "
GoTo CleanUp
End If
Set swSurf = swFace.GetSurface
vRefPointFeatureArray = swModel.FeatureManager.InsertReferencePoint(4, 0, 0.01, 1)
Set Feature = vRefPointFeatureArray(0)
Set RefPoint = Feature.GetSpecificFeature2
Set MathPoint = RefPoint.GetRefPoint
XYZ = MathPoint.ArrayData
Set MathPoint = Nothing
Set RefPoint = Nothing
Set Feature = Nothing
swApp.SendMsgToUser " Center of selected surface: " _
& vbCrLf _
& vbCrLf & " X = " & XYZ(0) * 1000 & " mm" _
& vbCrLf & " Y = " & XYZ(1) * 1000 & " mm" _
& vbCrLf & " Z = " & XYZ(2) * 1000 & " mm"
If swSurf.IsPlane Then
vPlane = swSurf.PlaneParams
swApp.SendMsgToUser " Selected Surface - PLANE " _
& vbCrLf & vbCrLf & " Normal = (" & vPlane(0) & ", " & vPlane(1) & ", " & vPlane(2) & ")" _
& vbCrLf & vbCrLf & " Root = (" & vPlane(3) * 1000# & ", " & vPlane(4) * 1000# & ", " & vPlane(5) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
ElseIf swSurf.IsCylinder Then
vCylinder = swSurf.CylinderParams
swApp.SendMsgToUser " Selected Surface - CYLINDER " _
& vbCrLf & vbCrLf & " Radius = " & vCylinder(6) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Axis = (" & vCylinder(3) & ", " & vCylinder(4) & ", " & vCylinder(5) & ")" _
& vbCrLf & vbCrLf & " Origin = (" & vCylinder(0) * 1000# & ", " & vCylinder(1) * 1000# & ", " & vCylinder(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
ElseIf swSurf.IsCone Then
vCone = swSurf.ConeParams
swApp.SendMsgToUser " Selected Surface - CONE " _
& vbCrLf & vbCrLf & " Radius = " & vCone(6) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Half angle = " & vCone(7) * 57.3 & " degrees" _
& vbCrLf & vbCrLf & " Axis = (" & vCone(3) & ", " & vCone(4) & ", " & vCone(5) & ")" _
& vbCrLf & vbCrLf & " Origin = (" & vCone(0) * 1000# & ", " & vCone(1) * 1000# & ", " & vCone(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
ElseIf swSurf.IsTorus Then
vTorus = swSurf.TorusParams
swApp.SendMsgToUser " Selected Surface - TORUS " _
& vbCrLf & vbCrLf & " Distance betwen center of torus and center of revolved circle = " & vTorus(7) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Radius of revolved circle = " & vTorus(6) * 1000# & " mm" _
& vbCrLf & vbCrLf & " Center = (" & vTorus(0) * 1000# & ", " & vTorus(1) * 1000# & ", " & vTorus(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " Axis = (" & vTorus(3) & ", " & vTorus(4) & ", " & vTorus(5) & ")" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName _
& vbCrLf & vbCrLf & " Major Radius of the torus = " & vTorus(6) * 1000# + vTorus(7) * 1000# & " mm ???"
ElseIf swSurf.IsSphere Then
vSphere = swSurf.SphereParams
swApp.SendMsgToUser " Selected Surface - SPHERE " _
& vbCrLf & vbCrLf & " Center = (" & vSphere(0) * 1000# & ", " & vSphere(1) * 1000# & ", " & vSphere(2) * 1000# & ") mm" _
& vbCrLf & vbCrLf & " Radius = " & vSphere(3) * 1000 & " mm" _
& vbCrLf & vbCrLf & " File = " & swModel.GetPathName
ElseIf swSurf.IsBlending Then
swApp.SendMsgToUser " Selected Surface - BLEND "
ElseIf swSurf.IsSwept Then
swApp.SendMsgToUser " Selected Surface - SWEPT "
GoTo CleanUp
ElseIf swSurf.IsRevolved Then
swApp.SendMsgToUser " Selected Surface - REVOLVED "
GoTo CleanUp
ElseIf swSurf.IsForeign Then
swApp.SendMsgToUser " Selected Surface - FOREIGN "
ElseIf swSurf.IsOffset Then
swApp.SendMsgToUser " Selected Surface - OFFSET "
ElseIf swSurf.IsParametric Then
swApp.SendMsgToUser " Selected Surafce - B-SPLINE SURFACE "
End If
If swFace.GetEdgeCount > 0 Then
swApp.SendMsgToUser swFace.GetEdgeCount & " edges found"
myEdges = swFace.GetEdges
For i = 0 To swFace.GetEdgeCount - 1
myEdges(i).Select False
Call MyEdgeData(myEdges(i), swApp)
Next i
Else
swApp.SendMsgToUser "The face has no edges"
End If
swFace.Select False
CleanUp:
Set swFace = Nothing
Set swSurf = Nothing
Set swSelMgr = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub
Sub MyEdgeData(ByVal swEdge As SldWorks.edge, ByVal swApp As SldWorks.SldWorks)
Const dPi = 3.141592654
Const MtoMM = 1000
Const M2toMM2 = 1000000
Const swSelEDGES = 1
Const swMbInformation = 2
Const swMbStop = 4
Const swMbOk = 2
Dim swCurve As Curve
Dim lngSelType As Long
Dim pt1 As Double
Dim pt2 As Double
Dim vpoint1 As Variant
Dim bVal1 As Boolean
Dim bVal2 As Boolean
Dim vSafeArray As Variant
Dim dLen As Double
Dim vParams As Variant
Dim sMsg As String
Set swCurve = swEdge.GetCurve
If swCurve.IsLine Then
Call swCurve.GetEndParams(pt1, pt2, bVal1, bVal2)
dLen = swCurve.GetLength2(pt1, pt2)
vParams = swEdge.GetCurveParams
sMsg = "Selected Edge - Line" & vbCrLf & vbCrLf _
& "Length = " & Format(dLen * MtoMM, "###,##0.000") & " mm" _
& vbCrLf & "Coordinates End Point1 : (" & Format(vParams(0) * 1000, "##,##0.000") & ", " _
& Format(vParams(1) * 1000, "##,##0.000") & ", " _
& Format(vParams(2) * 1000, "##,##0.000") & ")" & "" _
& vbCrLf & "Coordinates End Point2 : (" & Format(vParams(3) * 1000, "##,##0.000") & ", " _
& Format(vParams(4) * 1000, "##,##0.000") & ", " _
& Format(vParams(5) * 1000, "##,##0.000") & ")" & "" _
& vbCrLf & "Start Point = " & Format(vParams(6) * 1000, "##,##0.000") & " mm" _
& vbCrLf & "End Point = " & Format(vParams(7) * 1000, "##,##0.000") & " mm"
End If
If swCurve.IsCircle Then
vSafeArray = swCurve.CircleParams
sMsg = "Selected Edge - Circle" & vbCrLf & vbCrLf & _
"Center : (" & Format(vSafeArray(0) * MtoMM, "##,##0.000") & _
", " & Format(vSafeArray(1) * MtoMM, "##,##0.000") & _
", " & Format(vSafeArray(2) * MtoMM, "##,##0.000") & ")" & " (mm)" & vbCrLf & _
"Diameter = " & Format(vSafeArray(6) * 2 * MtoMM, "##,##0.000") & " mm" & vbCrLf & _
"Circumference = " & Format(2 * dPi * vSafeArray(6) * MtoMM, "##,##0.000") & " mm" & vbCrLf & _
"Area = " & Format(dPi * vSafeArray(6) ^ 2 * M2toMM2, "##,##0.000") & " mm²"
End If
If swCurve.IsBcurve Then
Call swCurve.GetEndParams(pt1, pt2, bVal1, bVal2)
dLen = swCurve.GetLength2(pt1, pt2)
vParams = swEdge.GetCurveParams
sMsg = "Selected Edge - Bcurve" & vbCrLf & vbCrLf & _
"Length = " & Format(dLen * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & "Coordinates End Point1 : (" & Format(vParams(0) * 1000, "##,##0.000") & " , " _
& Format(vParams(1) * 1000, "##,##0.000") & " , " _
& Format(vParams(2) * 1000, "##,##0.000") & ")" & "" _
& vbCrLf & "Coordinates End Point2 : (" & Format(vParams(3) * 1000, "##,##0.000") & " , " _
& Format(vParams(4) * 1000, "##,##0.000") & " , " _
& Format(vParams(5) * 1000, "##,##0.000") & ")" & ""
End If
If swCurve.IsEllipse Then
vSafeArray = swCurve.GetEllipseParams
sMsg = "Selected Edge - Ellipse" & vbCrLf & vbCrLf & _
"Center of ellipse : " _
& vbCrLf & " X = " & Format(vSafeArray(0) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & " Y = " & Format(vSafeArray(1) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & " Z = " & Format(vSafeArray(2) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & vbCrLf & "Major Radius = " & Format(vSafeArray(3) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & "Minor Radius = " & Format(vSafeArray(7) * MtoMM, "##,##0.000") & " mm" _
& vbCrLf & "Area = " & Format(dPi * vSafeArray(3) * 2 * vSafeArray(7) * 2 * M2toMM2, "##,##0.000") & " mm²" _
& vbCrLf & "Circumference ??? = " & Format(dPi * (3 * ((2 * vSafeArray(3) + 2 * vSafeArray(7)) / 2 - (2 * vSafeArray(3) * 2 * vSafeArray(7)) ^ 0.5) * MtoMM), "##,##0.000" & " mm")
End If
swApp.SendMsgToUser2 sMsg, swMbInformation, swMbOk
CleanUp:
Set swCurve = Nothing
End Sub
RE: Connect two macros...how?
RE: Connect two macros...how?