Folge 33 – Skizze erstellen II

Option Explicit
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
    Dim enableSnapping As Boolean
    enableSnapping = swApp.GetUserPreferenceToggle(swUserPreferenceToggle_e.swSketchInference)
    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swSketchInference, False
    swSketchMgr.InsertSketch True
    swSketchMgr.CreateCornerRectangle 0.001, 0.001, 0#, 0.101, 0.101, 0#
    swSketchMgr.InsertSketch True
    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swSketchInference, enableSnapping
End Sub