Hallo Leute
Ich erstelle momentan ein Makro, der in eine Zeichnung ein Blatt Namens "DXF" einfügt.
Hier komme ich aber ins Stottern. Da mein Wissen hinsichtlich Makros eingeschränkt ist.
Das Makro muss folgendes ausführen:
1. Einfügen eines Blattes Namens DXF aus Vorlage mit Blattmaßstab 1/1
2. Einfügen einer Abwicklungsansicht
3. Ausblenden aller Skizzen
4. Anpassen der Blattgösse 10mm größer als die Ansicht
5. Ausrichten der Ansicht auf Blattmitte
6. Prüfen ob die Ansicht auf Blattmaßstab eingestellt ist.
Zusätzlich würde ich Gene prüfen ob die Zeichnung ein Blechteil ist.
Ich habe hier schon was zusammen gewürfelt. Ein Teil ist aufgenommen, ein Teil ist aus anderen Makros und ein Teil habe ich selber programmiert.
Ich kriege es nicht hin die Skizzen auszublenden.
Code:
Dim swApp As Object
Dim Part As Object
Dim Feature As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Dim swApp As SldWorks.SldWorks
Dim DrawingDoc As Object
Dim Sheet As Object
Dim View As Object
Dim RefModelView As String
Dim RefModelName As String
Dim swView As SldWorks.View
Dim swModelView As SldWorks.ModelView
Dim swDraw As SldWorks.DrawingDoc
Dim swModel As SldWorks.ModelDoc2
Dim swViewPart As Object
Dim swAnsicht As String
Dim i As String
Set swApp = Application.SldWorks
Set DrawingDoc = swApp.ActiveDoc
If DrawingDoc Is Nothing Then
MsgBox "Kein Dokument offen"
Exit Sub
End If
If (DrawingDoc.GetType <> swDocDRAWING) Then
MsgBox "Nur für Zeichnungen sinnvoll"
Exit Sub
End If
Set Sheet = DrawingDoc.GetCurrentSheet
RefModelView = Sheet.CustomPropertyView
Set View = DrawingDoc.GetFirstView
If RefModelView = "Standard" Then
Set View = View.GetNextView
Else
Do While Not View Is Nothing
Set View = View.GetNextView
If View.GetName2 = RefModelView Then Exit Do
Loop
End If
If Not View Is Nothing Then
RefModelName = View.GetReferencedModelName
Debug.Print RefModelName
swPfad = RefModelName
Else
MsgBox "Kein referenziertes Modell gefunden, Zeichnung leer?"
End If
Set Part = swApp.ActiveDoc
'Set swViewPart = swDraw.ActiveDrawingView
Part.ClearSelection2 True
Part.ViewZoomtofit2
boolstatus = Part.NewSheet3("DXF", 12, 13, 1, 1, True, "g:\solidworks\solidworks_cfg\sw_vorlagen\a3_keytech.slddrt", 0.5, 0.5, "Standard")
boolstatus = Part.Extension.SelectByID2("DXF", "SHEET", 0.005, 0.005, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAutoInsertCenterMarksForHoles, 0, False)
boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAutoInsertCenterMarksForSlots, 0, False)
boolstatus = Part.CreateFlatPatternViewFromModelView(RefModelName, "_Standard", 0.25, 0.25, 0)
boolstatus = Part.Extension.SelectByID2(Count, "View", 0.25, 0.25, 0, False, 0, Nothing, 0)
Set swActiveView = Application.SldWorks.ActiveDoc.ActiveDrawingView
Count = Part.GetViewCount
If Not swActiveView Is Nothing Then
'Debug.Print " Aktieve Ansicht = " & swActiveView.GetName2
swAnsicht = swActiveView.GetName2
Else
MsgBox "Keinen Ansicht aktiv! "
Exit Sub
End If
boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAutoInsertCenterMarksForHoles, 0, True)
boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAutoInsertCenterMarksForSlots, 0, True)
Part.ClearSelection2 True
i = swSkizze(swPfad, swAnsicht)
Debug.Print "i= " & i
boolstatus = Part.ActivateView(swAnsicht)
Set swActiveView = Application.SldWorks.ActiveDoc.ActiveDrawingView
boolstatus = Part.Extension.SelectByID2(i, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.BlankSketch
Part.ClearSelection2 True
End Sub
Function swSkizze(ByVal swxPfad As String, ByVal swxAnsicht As String) As String
Dim a As String
a = swSkizzePfad(swxPfad)
swSkizze = "Biegung-Linie1@" & a & "@" & swxAnsicht
'Debug.Print swSkizze
Exit Function
End Function
Function swSkizzePfad(ByVal swxPfad2 As String) As String
Dim x As Integer
Dim y As Variant
Dim z As Integer
Dim t As Variant
Dim s As Variant
For x = Len(swxPfad2) To 0 Step -1
y = Right(Left(swxPfad2, x), 1)
'Debug.Print y; x
If y = "." Then
For z = Len(Left(swxPfad2, x - 1)) To 0 Step -1
t = Right(Left(swxPfad2, z), 1)
If t = "\" Then
s = Right(Left(swxPfad2, x - 1), (Len(swxPfad2) - z) - (Len(swxPfad2) - x + 1))
'Debug.Print s
swSkizzePfad = s
Exit For
End If
Next z
Exit For
End If
Next x
Exit Function
End Function
Bitte nachsichtig sein. Der CODE ist nicht bereinigt.
Ich werde den CODE noch ordentlich Zusammen Fassen wenn er FUNZT.
Danke im Voraus
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP