×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Connect two macros...how?

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

RE: Connect two macros...how?

Cannot you just combine the macros into one?

RE: Connect two macros...how?

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.

I could be the world's greatest underachiever, if I could just learn to apply myself.
http://www.EsoxRepublic.com-SolidWorks API VB programming help

RE: Connect two macros...how?

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.

RE: Connect two macros...how?

(OP)
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)
    

RE: Connect two macros...how?

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

RE: Connect two macros...how?

(OP)
Oh yeah!That is that what I need!Thanks handleman for your great help!!!

RE: Connect two macros...how?

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).  

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources