Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations GregLocock on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Connect two macros...how? 1

Status
Not open for further replies.

picia

Mechanical
Mar 24, 2006
26
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
 
Replies continue below

Recommended for you

I don't see why you can't just cut-and-paste code from one into the other. Just be sure you do not double the difinitions of your variables, especially object variables.

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.

[bat]I could be the world's greatest underachiever, if I could just learn to apply myself.[bat]
-SolidWorks API VB programming help
 
The reason he can't cut and paste is that the two macros have different initial conditions. For the first, a surface/face must be selected prior to running. For the second, an edge must be selected. If I understand correctly, what picia would like to do is select the face and run the one macro that will give him the face data and the data on its bounding edge(s).

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.
 
hello.
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)
 
Picia:
Enjoy!

Code:
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
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
 
Oh yeah!That is that what I need!Thanks handleman for your great help!!!
 
With a little tinkering, this macro could be made more robust by adding a userform with the objects fed into a listbox where the user can choose which object to get information on...with the info displayed in a label next to it (instead of a separate msgbox popping up).
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor