Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  DXF Makro

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS
  
3DEXPERIENCE SOLIDWORKS: Ihre Konstruktionslösung der nächsten Generation
Autor Thema:  DXF Makro (1647 mal gelesen)
Matrix82
Mitglied
Konstrukteur


Sehen Sie sich das Profil von Matrix82 an!   Senden Sie eine Private Message an Matrix82  Schreiben Sie einen Gästebucheintrag für Matrix82

Beiträge: 64
Registriert: 11.03.2011

Jäh nach Auftrag<P>Software:
SW 2010 - 2013
Office 2003 - 2010
Inventor 10 - 2013
AutCAD Mech. 10 - 2012
PDM, Kompass, Keytech, SAP, ...
VB bis 2010
C++, CNC Sinumeric,
v. CAD/CAM<P>Hardware:
2x Hp Envy 3D
auf max. ausgerüstet

erstellt am: 02. Apr. 2012 11:01    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


DXF1.jpg

 
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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2024 CAD.de | Impressum | Datenschutz