Hi,

I have to create axes and planes in many models to make complex joints possible in an assembly.

Therefore I want to use a macro.

The idea is to open an existing model, make a sketch of a feature visible, select the appropriate sketch point and run the macro.
The code below creates the axes perfectly, but did not create any refplane...

Any ideas are welcome.

Andreas.

Option Explicit

Sub Main()
  Dim swApp As SldWorks.SldWorks
  Dim swModel As SldWorks.ModelDoc2
  Dim swSelMgr As SldWorks.SelectionMgr
  Dim swFeat As SldWorks.Feature
  Dim swPoint As SldWorks.SketchPoint
  Dim swSelData As SldWorks.SelectData
  Dim boolstatus As Boolean

  Dim myRefPlane As SldWorks.RefPlane
  Dim i As Long, j As Long
  Dim sPLane, dPlane, dAxis

  sPLane = Array("a", "b", "c")
  dPlane = Array("Ebene X", "Ebene Y", "Ebene Z")
  dAxis = Array("Z-Achse", "Y-Achse", "X-Achse")

  Set swApp = Application.SldWorks
  Set swModel = swApp.ActiveDoc
  Set swSelMgr = swModel.SelectionManager
  Set swSelData = swSelMgr.CreateSelectData
 
  'Just to be sure
  Dim swSketchMgr As SldWorks.SketchManager
  Dim swSketch As SldWorks.Sketch
  Set swSketchMgr = swModel.SketchManager
  Set swSketch = swSketchMgr.ActiveSketch
  If Not swSketch Is Nothing Then
    MsgBox "Exit the sketch, then select the point and try again"
    Exit Sub
  End If
  If swSelMgr.GetSelectedObjectCount2(-1) = 0 Then
    MsgBox "Select a point and try again"
    Exit Sub
  End If
  If swSelMgr.GetSelectedObjectType3(1, -1) <> swSelectType_e.swSelEXTSKETCHPOINTS Then
    MsgBox "Select a point and try again"
    Exit Sub
  End If
  'Get the selected point
  Set swPoint = swSelMgr.GetSelectedObject6(1, -1)

  'Get the names of the default planes
  Set swFeat = swModel.FirstFeature
  j = 0
  Do While Not swFeat Is Nothing
    If "RefPlane" = swFeat.GetTypeName Then
      sPLane(j) = swFeat.Name
      If j = UBound(sPLane) Then Exit Do
      j = j + 1
    End If
    Set swFeat = swFeat.GetNextFeature
  Loop

  For i = 0 To 2
    'Create the axis
    swModel.ClearSelection2 True
    swPoint.Select4 True, swSelData
    boolstatus = swModel.Extension.SelectByID2(sPLane(i), "PLANE", 0, 0, 0, True, 0, Nothing, 0)
    boolstatus = swModel.InsertAxis2(True)
    Set swFeat = swModel.Extension.GetLastFeatureAdded
    swFeat.Select2 False, -1
    boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, dAxis(i))

    'Create the plane
    swModel.ClearSelection2 True
    swPoint.Select4 True, swSelData
   
    'I tried also this, point is selected, but did not work either
    'boolstatus = swModel.Extension.SelectByID2("", "EXTSKETCHPOINT", swPoint.X, swPoint.Y, swPoint.Z, False, 0, Nothing, 0)
   
    'Recorded code, did not work either
    'boolstatus = swModel.Extension.SelectByID2("Point3@Skica2", "EXTSKETCHPOINT", 0, 0.303815, 0, False, 0, Nothing, 0)
   
    boolstatus = swModel.Extension.SelectByID2(sPLane(i), "PLANE", 0, 0, 0, True, 0, Nothing, 0)
    Set myRefPlane = swModel.FeatureManager.InsertRefPlane(4, 0, 1, 0, 0, 0)
    Set swFeat = swModel.Extension.GetLastFeatureAdded
    swFeat.Select2 False, -1
    'boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, dPlane(i))
  Next
End Sub