Create Coordinate System Feature (VBA)

This example creates a coordinate system feature. The example then accesses the feature and edits it.

'-----------------------------------------

' Precondition: Model document is open.

'

' Postconditions: Coordinate system feature is created.

'-----------------------------------------

Option Explicit

 

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swSelMgr As SldWorks.SelectionMgr

Dim swFeat As SldWorks.Feature

Dim swFeatMgr As SldWorks.FeatureManager

Dim cSysData As SldWorks.CoordinateSystemFeatureData

Dim component As SldWorks.Component2

Dim boolstatus As Boolean

Dim vo As Variant

Dim vx As Variant

Dim vy As Variant

Dim vz As Variant

Dim evo As Variant

Dim evx As Variant

Dim evy As Variant

Dim evz As Variant

Dim so(0) As Object

Dim sx(1) As Object

Dim sy(1) As Object

Dim sz(1) As Object

Dim eso(0) As Object

Dim esx(1) As Object

Dim esy(1) As Object

Dim esz(1) As Object

Dim xEnt   As Object

 

Sub main()

 

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swSelMgr = swModel.SelectionManager

Set swModelDocExt = swModel.Extension

Set swFeatMgr = swModel.FeatureManager

boolstatus = swModelDocExt.SelectByID2("", "VERTEX", 0, 0.00635, 0, False, 0, Nothing, 0)

boolstatus = swModelDocExt.SelectByID2("", "FACE", 0.0308159564126, 0.006349999999827, 0.01220751949762, True, 0, Nothing, 0)

boolstatus = swModelDocExt.SelectByID2("", "VERTEX", 0.0762, 0.00635, 0.01905, True, 0, Nothing, 0)

boolstatus = swModelDocExt.SelectByID2("", "VERTEX", 0.0762, 0.00635, 0, True, 0, Nothing, 0)

 

' Assume a vertex was selected for the origin

Set so(0) = swSelMgr.GetSelectedObject6(1, -1)

' Assume one entity (point, line/edge, plane/face) was selected for the x axis

Set sx(0) = swSelMgr.GetSelectedObject6(2, -1)

' Assume two entities (point, line/edge, plane/face) were selected for the y axis

Set sy(0) = swSelMgr.GetSelectedObject6(3, -1)

Set sy(1) = swSelMgr.GetSelectedObject6(4, -1)

' Try getting additional selected entities for the z axis

Set sz(0) = swSelMgr.GetSelectedObject6(5, -1)

Set sz(1) = swSelMgr.GetSelectedObject6(6, -1)

 

vo = so

vx = sx

vy = sy

vz = sz

 

swModel.ClearSelection2 True

 

' Create coordinate system

Set swFeat = swFeatMgr.CreateCoordinateSystem(so(0), (vx), (vy), (vz))

    

If swFeat Is Nothing Then

    Debug.Print "Did not create a coordinate system feature!"

Else

    Set cSysData = swFeat.GetDefinition

    boolstatus = cSysData.AccessSelections(swModel, component)

    

    ' Get and output the transform

    Dim swXform  As SldWorks.MathTransform

    Set swXform = cSysData.Transform

    Debug.Print "    Origin = (" & -1# * swXform.ArrayData(9) * 1000# & ", " & -1# * swXform.ArrayData(10) * 1000# & ", " & -1# * swXform.ArrayData(11) * 1000# & ") mm"

    Debug.Print "    Rot1   = (" & swXform.ArrayData(0) & ", " & swXform.ArrayData(1) & ", " & swXform.ArrayData(2) & ")"

    Debug.Print "    Rot2   = (" & swXform.ArrayData(3) & ", " & swXform.ArrayData(4) & ", " & swXform.ArrayData(5) & ")"

    Debug.Print "    Rot3   = (" & swXform.ArrayData(6) & ", " & swXform.ArrayData(7) & ", " & swXform.ArrayData(8) & ")"

    Debug.Print "    Trans  = (" & swXform.ArrayData(9) * 1000# & ", " & swXform.ArrayData(10) * 1000# & ", " & swXform.ArrayData(11) * 1000# & ") mm"

    Debug.Print "    Scale  = " & swXform.ArrayData(12)

    

    Debug.Print "XFlipped? " & cSysData.XFlipped

    cSysData.XFlipped = True

   

    

    ' Select new entities for editing the coordinate system feature

    boolstatus = swModelDocExt.SelectByID2("", "VERTEX", 0, 0.00635, 0.01905, False, 0, Nothing, 0)

    boolstatus = swModelDocExt.SelectByID2("", "EDGE", 0.03505266269053, -6.420391980555E-05, 0.01914079805448, True, 2, Nothing, 0) ' Assume a vertex was selected for the origin

    boolstatus = swModelDocExt.SelectByID2("", "FACE", 0.0308159564126, 0.006349999999827, 0.01220751949762, True, 3, Nothing, 0)

    

    ' Edit the origin

    Set eso(0) = swSelMgr.GetSelectedObject6(1, -1)

    

    ' Edit the y axis

    ' Assume two entities (point, line/edge, plane/face) were selected for the y axis

   

    Set esy(0) = swSelMgr.GetSelectedObject6(2, -1)

    Set esz(0) = swSelMgr.GetSelectedObject6(3, -1)

    

    evo = eso

    evy = esy

    evz = esz

    

    swModel.ClearSelection2 True

   

    cSysData.OriginEntity = eso(0)

    cSysData.YAxisEntities = evy

    

    ' Try appending z-axis entities to see if they replace x-axis entity

    ' If this happens, then y and z are the active axes,

    ' and x-axis entity is inaccessible

    cSysData.ZAxisEntities = evz

    

    ' Get the origin entity

    Dim entType As Long

    Stop

    Dim geo As SldWorks.Entity

    Set geo = cSysData.OriginEntity

    entType = geo.GetType

    

    ' Get the x-axis entities; there shouldn't be any, because x is not active

    Dim gv As Variant

    Dim vCount As Long

    vCount = cSysData.GetXAxisEntitiesCount

    gv = cSysData.XAxisEntities

    

    Dim i As Long

  

    ' Get the y-axis entities

    vCount = cSysData.GetYAxisEntitiesCount

    gv = cSysData.YAxisEntities

    

        

    For i = 0 To UBound(gv)

        Set xEnt = gv(i)

        entType = xEnt.GetType

    Next i

    

    boolstatus = swFeat.ModifyDefinition(cSysData, swModel, Nothing)

    

    cSysData.ReleaseSelectionAccess

End If

 

swModel.EditRebuild3

 

End Sub