Folge 32 – Skizze erstellen I

Option Explicit
Const WAY As String = "DIM"
Sub main()
    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks
    
    Dim swModel As ModelDoc2
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then
        swApp.SendMsgToUser2 "Kein Dokument geladen.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
        End
    End If
    
    If swModel.GetType <> swDocPART Then
        swApp.SendMsgToUser2 "Dieses Makro ist nur für Teil-Dateien gedacht.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
        End
    End If
    
    Dim selected As Boolean
    selected = swModel.Extension.SelectByID2("Ebene vorne", "PLANE", 0, 0, 0, False, -1, Nothing, 0)
    
    Dim swSketchMgr As SketchManager
    Set swSketchMgr = swModel.SketchManager
    
    swSketchMgr.InsertSketch True
    
    Dim swSketchSeg As SketchSegment
    Set swSketchSeg = swSketchMgr.CreateLine(0.1, 0.1, 0, 0.2, 0.2, 0)
    
    If WAY = "CON" Then
        selected = swModel.Extension.SelectByID2("", "SKETCHPOINT", 0.1, 0.1, 0, False, -1, Nothing, 0)
        selected = swModel.Extension.SelectByID2("", "SKETCHPOINT", 0.2, 0.2, 0, True, -1, Nothing, 0)
        swModel.SketchAddConstraints "sgFIXED"
    End If
    
    If WAY = "DIM" Then
        swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False
        
        Dim swDispDim As DisplayDimension
        'Set swDispDim = swModel.AddDimension2(0.2, 0.2, 0)
        selected = swSketchSeg.Select4(False, Nothing)
        Set swDispDim = swModel.AddVerticalDimension2(0, 0.15, 0)
        selected = swSketchSeg.Select4(False, Nothing)
        Set swDispDim = swModel.AddHorizontalDimension2(0.15, 0, 0)
        
        selected = swModel.Extension.SelectByID2("", "SKETCHPOINT", 0.1, 0.1, 0, False, -1, Nothing, 0)
        selected = swModel.Extension.SelectByID2("", "EXTSKETCHPOINT", 0, 0, 0, True, -1, Nothing, 0)
        Set swDispDim = swModel.AddVerticalDimension2(0, 0.05, 0)
        
        selected = swModel.Extension.SelectByID2("", "SKETCHPOINT", 0.1, 0.1, 0, False, -1, Nothing, 0)
        selected = swModel.Extension.SelectByID2("", "EXTSKETCHPOINT", 0, 0, 0, True, -1, Nothing, 0)
        Set swDispDim = swModel.AddHorizontalDimension2(0.05, 0, 0)
        
        swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, True
    End If
    swSketchMgr.InsertSketch True
End Sub