---

T19-2.dwg

Hallo

ich habe mir ein kleines tool geschrieben welches mir meinen dynamischen block in dxf exportiert und diesen dann BURSTet (expresstools).
hat bis dato auch ganz gut funktioniert auch mit Dynamischen blöcken die Abhängigkeitsparameter eingebaut haben.
Jetzt wollte dies wieder mal anwenden, jedoch funktioniert es nicht mehr, ich bekomme immer die Fehlermeldung:

in BLOCKHORIZONTALCONSTRAINTPARAMETER beginnend bei Zeile 16262 ermittelt:

Fehlender DXF-Gruppencode: 1
Ungültige oder unvollständige DXF-Eingabe -- Zeichnung abgebrochen.

Bereinigen und Prüfen hilft da nix. auch wenn ich den Abhängigkeitsparameter rauslösche kann ich den export bei dem block nicht mehr durchführen. mir ist leider nicht bekannt bzw. bewusst, was ich im code geändert habe, dass das jetzt nicht mehr funktioniert. vielleicht kann mir jemand von euch helfen.
anbei die Datei.
hier der Code

Code:

---

Option Explicit
Dim mat, pos, anz, typ
Dim tBlRef As AcadBlockReference
Dim tBlRef_DynProps, posattr, tPnt As Variant
Dim tblRef_DynProp As IAcadDynamicBlockReferenceProperty
Dim StrAtt, exportFile, dxfname As String
Dim I, II, z As Integer
Dim SSet As AcadSelectionSet 'VAR 1
Dim VAR, varzsl, varab2, varHoehe, varLB, varab3, KSu, KSo, KSs, mKS
Dim varname

Public Function ssetGen(setName As String) As AcadSelectionSet 'falls auswahl bereich bereits definiert

Dim sCol As AcadSelectionSets
Dim ss As AcadSelectionSet
Set sCol = ThisDrawing.SelectionSets
For Each ss In sCol
    If ss.name = setName Then
        sCol.Item(setName).Delete
        Exit For
    End If
Next
Set ss = sCol.Add(setName)
Set ssetGen = ss
End Function

Public Sub DXFout2004()

    On Error Resume Next
    Call ThisDrawing.Utility.GetEntity(tBlRef, tPnt) 'Auswählen des Objekts
    If (tBlRef Is Nothing) Then
    Else
        tBlRef_DynProps = tBlRef.GetDynamicBlockProperties
        For I = 0 To UBound(tBlRef_DynProps)
            Set tblRef_DynProp = tBlRef_DynProps(I)
            If UCase(tblRef_DynProp.PropertyName) = "MATERIAL" Then mat = tblRef_DynProp.Value 'Materialstärke auslesen
            If UCase(tblRef_DynProp.PropertyName) = "STK" Then anz = tblRef_DynProp.Value 'Stückzahl auslesen
            If Not UCase(tblRef_DynProp.PropertyName) = "SICHTBARKEIT1" Then mKS = "" 'Sichtbarkeit auslesen
        Next
    End If
    On Error GoTo 0
'Position Attribut auslesen.
    posattr = tBlRef.GetAttributes
    For II = 0 To UBound(posattr)
        StrAtt = StrAtt & "  Tag: " & posattr(II).TagString & _
                        "  Value: " & posattr(II).TextString & "    "
        If posattr(II).TagString = "POSNR" Then pos = posattr(II).TextString & ""
        If posattr(II).TagString = "TYP" Then typ = posattr(II).TextString & ""
    Next
       
'Export nach dxf
    Dim exportFile As String
    Dim dxfname As String
    Dim SSet As AcadSelectionSet 'VAR 1
    'MsgBox "Bis da her passts 5", vbOKOnly
    'Set SSet = ThisDrawing.SelectionSets.Add(pos & "_" & mat & "_" & anz & " Stk") 'VAR1
    'Set SSet = ThisDrawing.SelectionSets.Add("TEST") 'VAR1
    'Set SSet = ssetGen("Auswahl") 'VAR funkt
    'SSet.SelectOnScreen 'Auswählen des Blocks 'var funkt
    'SSet.Highlight True
'MsgBox "bis da her passts 6", vbOKOnly

    If Dir("C:\DXF-Export", vbDirectory) = "" Then MkDir ("C:\DXF-Export")
    Select Case mat
        Case 0.5
            If Dir("C:\DXF-Export\5", vbDirectory) = "" Then MkDir ("C:\DXF-Export\5")
            'exportFile = "C:\DXF-Export\5\" & pos & "_" & mat & "_" & anz & " Stk" 'VAR1
            'ThisDrawing.Export exportFile, "DXF", SSet
            'ThisDrawing.SendCommand "filedia 0"
            'ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\5\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & V = "R12" 'VAR2
            'ThisDrawing.SendCommand "burst "
            ' ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\5\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "O alle  " & "16 "
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\5\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V 2000 " & "16 "
            dxfname = "C:\DXF-Export\5\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            'On Dir(dxfname) <> "" GoTo Offnen
            If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
              End Select
            End If
        Case 0.75
            If Dir("C:\DXF-Export\7,5", vbDirectory) = "" Then MkDir ("C:\DXF-Export\7,5")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\7,5\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V 2000 " & "16 "
            dxfname = "C:\DXF-Export\7,5\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            'On Dir(dxfname) <> "" GoTo Offnen
            If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
              End Select
            End If
        Case 1
            If Dir("C:\DXF-Export\10", vbDirectory) = "" Then MkDir ("C:\DXF-Export\10")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\10\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V 2000 " & "16 "
            dxfname = "C:\DXF-Export\10\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            'On Dir(dxfname) <> "" GoTo Offnen
            If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
              End Select
            End If
        Case 1.25
            If Dir("C:\DXF-Export\12,5", vbDirectory) = "" Then MkDir ("C:\DXF-Export\12,5")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\12,5\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V 2000 " & "16 "
            dxfname = "C:\DXF-Export\12,5\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            'On Dir(dxfname) <> "" GoTo Offnen
            If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                End Select
            End If
        Case 1.5
            If Dir("C:\DXF-Export\15", vbDirectory) = "" Then MkDir ("C:\DXF-Export\15")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\15\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V 2000 " & "16 "
            dxfname = "C:\DXF-Export\15\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            'On Dir(dxfname) <> "" GoTo Offnen
            If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            MsgBox "Sichtbarkeit: mit", vbOKOnly
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
              End Select
            End If
        Case 2
            If Dir("C:\DXF-Export\20", vbDirectory) = "" Then MkDir ("C:\DXF-Export\20")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\20\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V 2000 " & "16 "
            dxfname = "C:\DXF-Export\20\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            'On Dir(dxfname) <> "" GoTo Offnen
            If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
              End Select
            End If
        Case 2.5
            If Dir("C:\DXF-Export\25", vbDirectory) = "" Then MkDir ("C:\DXF-Export\25")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\25\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V 2000 " & "16 "
            dxfname = "C:\DXF-Export\25\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            'On Dir(dxfname) <> "" GoTo Offnen
            If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                End Select
            End If
        Case Else
            If Dir("C:\DXF-Export\", vbDirectory) = "" Then MkDir ("C:\DXF-Export\")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V 2000 " & "16 "
            dxfname = "C:\DXF-Export\" & typ & "_" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            'On Dir(dxfname) <> "" GoTo Offnen
            If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                End Select
            End If
    End Select
    mKS = ""
    ThisDrawing.SendCommand "filedia 1 "

End

   

    'MsgBox "MAterial=" & mat, vbOKOnly
   
    'SSet.Clear
 
'ThisDrawing.SendCommand "filedia 0 dxfout C:\Exportfile" & vbCr & "O Vorher  "
'ThisDrawing.SendCommand "filedia 1 "
   
End Sub

Public Sub DynBlockUpdate()

 
 
    On Error Resume Next
    Call ThisDrawing.Utility.GetEntity(tBlRef, tPnt)
    varzsl = 0
    If (tBlRef Is Nothing) Then 'Auswahl des Blocks
    Else
        tBlRef_DynProps = tBlRef.GetDynamicBlockProperties
        z = 0
        'varzsl = InputBox("Bitte die gewünschte Länge eingeben: ", "Länge")'funktioniert nicht
        Do
        For I = 0 To UBound(tBlRef_DynProps)
            Set tblRef_DynProp = tBlRef_DynProps(I)
            If UCase(tblRef_DynProp.PropertyName) = "ZSL" Then
                varzsl = tblRef_DynProp.Value 'Zuschnittlänge auslesen
                'MsgBox "ZSL= " & varzsl, vbOKOnly
                Else
                    If UCase(tblRef_DynProp.PropertyName) = "LB" Then varLB = tblRef_DynProp.Value 'Leibung auslesen
                    'MsgBox "LB= " & varLB, vbOKOnly
            End If
            VAR = Int(((varzsl - 130) / 100.5)) * (10 ^ 0) / (10 ^ 0) 'Berechnen der oberen Länge mit abrunden
            varab2 = (130 + (100.5 * VAR))
            varab3 = (varzsl - (30 * 4)) / 3

            If varzsl > 0 Then
                'VAR = Int(((varzsl - 130) / 100.5)) * (10 ^ 0) / (10 ^ 0) 'Berechnen der oberen Länge mit abrunden
                'varab2 = (130 + (100.5 * VAR))
                If UCase(tblRef_DynProp.PropertyName) = "ABSTAND1" Then tblRef_DynProp.Value = varzsl 'Zuweisen der Zuschnittlänge
                If UCase(tblRef_DynProp.PropertyName) = "ABSTAND2" Then tblRef_DynProp.Value = varab2 'Zuweisen der Oberen länge
                If UCase(tblRef_DynProp.PropertyName) = "EINZUG" Then tblRef_DynProp.Value = (40.5 + varLB - 90) 'Zuweisen des Einzugs
                If UCase(tblRef_DynProp.PropertyName) = "ABSTAND3" Then tblRef_DynProp.Value = (((varzsl - (30 * 4)) / 3) - 0.005) 'Zuweisen des Abstands
                If UCase(tblRef_DynProp.PropertyName) = "ABSTAND4" Then tblRef_DynProp.Value = (((varzsl - (30 * 4)) / 3)) 'Zuweisen des Abstands
                If UCase(tblRef_DynProp.PropertyName) = "ABSTAND5" Then tblRef_DynProp.Value = (((varzsl - (30 * 4)) / 3)) 'Zuweisen des Abstands
                If UCase(tblRef_DynProp.PropertyName) = "ANO1" Then tblRef_DynProp.Value = (((Round(((varzsl - 200) / 2) / 250)) * 250))
                If UCase(tblRef_DynProp.PropertyName) = "ANO2" Then tblRef_DynProp.Value = (((Round(((varzsl - 200) / 2) / 250)) * 250))

            End If
            If varLB > 0 Then
                'MsgBox "LB= " & varLB, vbOKOnly
                If UCase(tblRef_DynProp.PropertyName) = "HOEHE" Then tblRef_DynProp.Value = (varLB + (82.031)) 'Zuweisen der Höhe
                If UCase(tblRef_DynProp.PropertyName) = "HOHE2" Then tblRef_DynProp.Value = (varLB + (9.09)) 'Zuweisen der Höhe
                If UCase(tblRef_DynProp.PropertyName) = "TZHOEHE" Then tblRef_DynProp.Value = (varLB + 26.94) 'Zuweisen der Höhe
                If UCase(tblRef_DynProp.PropertyName) = "TZHOEHE2" Then tblRef_DynProp.Value = (varLB + 9.33) 'Zuweisen der Höhe
               
            End If
            If UCase(tblRef_DynProp.PropertyName) = "SICHTBARKEIT1" Then mKS = tblRef_DynProp.Value
            If mKS = "Knochenbohrung" Then
                If UCase(tblRef_DynProp.PropertyName) = "KNOCHENEINZUGUNTEN" Then KSu = tblRef_DynProp.Value 'Knocheneinzugunten zuweisen
                If UCase(tblRef_DynProp.PropertyName) = "KNOCHENEINZUGOBEN" Then KSo = tblRef_DynProp.Value 'Knocheneinzugoben zuweisen
                If UCase(tblRef_DynProp.PropertyName) = "KNOCHENABSTAND" Then tblRef_DynProp.Value = ((varzsl - KSu - KSo) / 2) 'Knochenabstand zuweisen
                Else: mKS = "ohne Knochen"
            End If
        Next
        z = z + 1
        Loop Until z = 1
        'MsgBox " Sichtbarkeit = " & mKS, vbOKOnly
    End If
    On Error GoTo 0

End Sub

---

ach und da fällt mir noch eine Frage ein,
kann ich irgendwie dieses häufig wiederkehrende Codesegment irgendwie reduzieren, damit ich das nicht so oft drinnen habe, quasi als unterpunkt einer funktion?

Code:

---

If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            MsgBox "Sichtbarkeit: mit", vbOKOnly
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
              End Select
            End If

---

habs mit On .... goto... versucht, hat aber nicht so recht geklappt....

danke schon mal für eure hilfe!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

interessanterweise funktioniert es mit dem alten code schon noch..... der einzige unterschied hier ist, dass ich auf die sichtbarkeiten keine rücksicht nehme....

Code:

---

Public Sub DXFout2004()

Dim mat, pos, anz
Dim tBlRef As AcadBlockReference
Dim tBlRef_DynProps As Variant
Dim tBlRef_DynProp As IAcadDynamicBlockReferenceProperty
Dim tPnt As Variant
Dim I, z As Integer

    On Error Resume Next
    Call ThisDrawing.Utility.GetEntity(tBlRef, tPnt) 'Auswählen des Objekts
    If (tBlRef Is Nothing) Then
    Else
        tBlRef_DynProps = tBlRef.GetDynamicBlockProperties
        For I = 0 To UBound(tBlRef_DynProps)
            Set tBlRef_DynProp = tBlRef_DynProps(I)
            If UCase(tBlRef_DynProp.PropertyName) = "MATERIAL" Then
                mat = tBlRef_DynProp.Value 'Materialstärke auslesen
            End If
            If UCase(tBlRef_DynProp.PropertyName) = "STK" Then
                anz = tBlRef_DynProp.Value 'Stückzahl auslesen
            End If
        Next
    End If
    On Error GoTo 0
'MsgBox "Bis da her passts 1", vbOKOnly

'Position Attribut auslesen.
    Dim posattr As Variant
    posattr = tBlRef.GetAttributes
    'MsgBox "Bis da her passts 2 ", vbOKOnly
    ' Move the attribute tags and values into a string to be displayed in a Msgbox
    Dim StrAtt As String
    Dim II As Integer
    'MsgBox "Bis da her passts 3", vbOKOnly
    For II = 0 To UBound(posattr)
        StrAtt = StrAtt & "  Tag: " & posattr(II).TagString & _
                        "  Value: " & posattr(II).TextString & "    "
        pos = posattr(II).TextString & ""
    Next
    'MsgBox "Bis da her passts 4", vbOKOnly
    'MsgBox "The attributes for blockReference " & tBlRef.name & " are: " & StrAtt, , "GetAttributes Example"
    'MsgBox "Positionsnummer = " & pos, vbOKOnly
       

'MsgBox "Bis da her passts 5", vbOKOnly
'Export nach dxf
    Dim exportFile As String
    Dim dxfname As String
    Dim SSet As AcadSelectionSet 'VAR 1
    'MsgBox "Bis da her passts 5", vbOKOnly
    'Set SSet = ThisDrawing.SelectionSets.Add(pos & "_" & mat & "_" & anz & " Stk") 'VAR1
    'Set SSet = ThisDrawing.SelectionSets.Add("TEST") 'VAR1
    ' Set SSet = ssetGen("Auswahl") 'VAR funkt
    ' SSet.SelectOnScreen 'Auswählen des Blocks 'var funkt
    'SSet.Highlight True
'MsgBox "bis da her passts 6", vbOKOnly

    If Dir("C:\DXF-Export", vbDirectory) = "" Then MkDir ("C:\DXF-Export")
    Select Case mat
        Case 0.5
            'MsgBox "Material =" & mat, vbOKOnly
            If Dir("C:\DXF-Export\5", vbDirectory) = "" Then MkDir ("C:\DXF-Export\5")
            'exportFile = "C:\DXF-Export\5\" & pos & "_" & mat & "_" & anz & " Stk" 'VAR1
            'ThisDrawing.Export exportFile, "DXF", SSet
            'ThisDrawing.SendCommand "filedia 0"
            'ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\5\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & V = "R12" 'VAR2
            'ThisDrawing.SendCommand "burst "
            ' ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\5\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "O alle  " & "16 "
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\5\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "16 "
            dxfname = "C:\DXF-Export\5\" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            If Dir(dxfname) <> "" Then
                ThisDrawing.Application.Documents.Open dxfname
                ThisDrawing.SendCommand "BURST alle  _close    "
            End If
            'ThisDrawing.SendCommand "filedia 1 " 'VAR2
        Case 0.75
            If Dir("C:\DXF-Export\7,5", vbDirectory) = "" Then MkDir ("C:\DXF-Export\7,5")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\7,5\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "16 "
            dxfname = "C:\DXF-Export\7,5\" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            If Dir(dxfname) <> "" Then
                ThisDrawing.Application.Documents.Open dxfname
                ThisDrawing.SendCommand "BURST alle  _close    "
            End If
        Case 1
            If Dir("C:\DXF-Export\10", vbDirectory) = "" Then MkDir ("C:\DXF-Export\10")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\10\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "16 "
            dxfname = "C:\DXF-Export\10\" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            If Dir(dxfname) <> "" Then
                ThisDrawing.Application.Documents.Open dxfname
                ThisDrawing.SendCommand "BURST alle  _close    "
            End If
        Case 1.25
            If Dir("C:\DXF-Export\12,5", vbDirectory) = "" Then MkDir ("C:\DXF-Export\12,5")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\12,5\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "16 "
            dxfname = "C:\DXF-Export\12,5\" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            If Dir(dxfname) <> "" Then
                ThisDrawing.Application.Documents.Open dxfname
                ThisDrawing.SendCommand "BURST alle  _close    "
            End If
        Case 1.5
            If Dir("C:\DXF-Export\15", vbDirectory) = "" Then MkDir ("C:\DXF-Export\15")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\15\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "16 "
            dxfname = "C:\DXF-Export\15\" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            If Dir(dxfname) <> "" Then
                ThisDrawing.Application.Documents.Open dxfname
                ThisDrawing.SendCommand "BURST alle  _close    "
            End If
        Case 2
            If Dir("C:\DXF-Export\20", vbDirectory) = "" Then MkDir ("C:\DXF-Export\20")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\20\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "16 "
            dxfname = "C:\DXF-Export\20\" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            If Dir(dxfname) <> "" Then
                ThisDrawing.Application.Documents.Open dxfname
                ThisDrawing.SendCommand "BURST alle  _close    "
            End If
        Case 2.5
            If Dir("C:\DXF-Export\25", vbDirectory) = "" Then MkDir ("C:\DXF-Export\25")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\25\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "16 "
            dxfname = "C:\DXF-Export\25\" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            If Dir(dxfname) <> "" Then
                ThisDrawing.Application.Documents.Open dxfname
                ThisDrawing.SendCommand "BURST alle  _close    "
            End If
        Case Else
            If Dir("C:\DXF-Export\", vbDirectory) = "" Then MkDir ("C:\DXF-Export\")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr & "V R12 " & "16 "
            dxfname = "C:\DXF-Export\" & pos & "_" & mat * 10 & "_" & anz & " Stk.dxf"
            If Dir(dxfname) <> "" Then
                ThisDrawing.Application.Documents.Open dxfname
                ThisDrawing.SendCommand "BURST alle  _close    "
            End If
    End Select
    'MsgBox "MAterial=" & mat, vbOKOnly
   
    'SSet.Clear
    'ThisDrawing.SendCommand "filedia"
    'ThisDrawing.SendCommand "1"
    'ThisDrawing.SendCommand "ZU "
   
'ThisDrawing.SendCommand "filedia 0 dxfout C:\Exportfile" & vbCr & "O Vorher  "
'ThisDrawing.SendCommand "filedia 1 "
   
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von MichlB1003:

ach und da fällt mir noch eine Frage ein,
kann ich irgendwie dieses häufig wiederkehrende Codesegment irgendwie reduzieren, damit ich das nicht so oft drinnen habe, quasi als unterpunkt einer funktion?

Code:

---

If Dir(dxfname) <> "" Then
                Select Case True
                    Case mKS = "ohne Knochen"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
                    Case mKS = "Knochenbohrung"
                            MsgBox "Sichtbarkeit: mit", vbOKOnly
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = ""
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  _close    "
                    Case mKS = "ohne Kreis"
                            ThisDrawing.Application.Documents.Open dxfname
                            ThisDrawing.SendCommand "BURST alle  "
              End Select
            End If

---

habs mit On .... goto... versucht, hat aber nicht so recht geklappt....

danke schon mal für eure hilfe!

---

Versuch doch dir daraus ne eigene Sub zu machen und die einfach nur zu callen.

Gruß Chris

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP