---

Hallo

Ich möchte gerne den dxfout Befehl von einem Makro ausführen lassen. Habe aber bisher noch nichts passendes an Code gefunden. Habe aber schon mal einen Code gebastelt der leider nicht funktioniert...

Code:

---

Sub export()

Dim objExportFile As AcadDocument

Set Sset = ssetGen("Auswahl")
Sset.SelectOnScreen

'Hier werden per Makro noch Korrekturen an der Auswahl vorgenommen

objExportFile = Sset
objExportFile.SaveAs "c:\exportfile.dxf", ac2000_dxf

End Sub

---

Die Arbeitsweise soll folgende sein.
1. Code starten
2. Auswahl der zu speichernden Objekte
3. Objekte als dxfdatei speichern

Wer kann mir weiter helfen?

Gruss Koala

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

---

Hi,

ein SelectionSet kann nicht zu einen AcadDocument gecastet werden. Schau Dir mal die Funktion WBLOCK an.

- alfred -

------------------
www.hollaus.at

---

Hallo

Vielen Dank für die schnelle Antwort.

Wenn ich das richtig sehe, soll ich einen Block erstellen. Das ist aber nicht mein Ziel. Ich möchte doch eigentlich nur die markierten Objekte als dxf speichern.
Oder kann ich einen Block als dxf speichern? Es muss unbedingt dxf Format sein, da die Daten von einer anderen Software gelesen werden.

Gruss, Koala

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

---

(setq AWS (ssget))
(command "_dxfout" "C:\\bsp.dxf" "_o" AWS "" "")

wäre es in Lisp ...

------------------
  - Thomas -          
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Hi,

Beispiel aus der Hilfe, wenn's DXF sein muss (hab vorher zu wenig genau geschaut ):

Code:

---

Sub Example_Export()
    ' This example exports the current drawing to DXF format.
    ' Note that a valid selection set must be provided, even
    ' though the contents of the selection set are ignored.
   
   
    ' Define the name for the exported file
    Dim exportFile As String
    exportFile = "C:\AutoCAD\DXFExprt"    ' Adjust path to match your system
   
    ' Create an empty selection set
    Dim sset As AcadSelectionSet
    Set sset = ThisDrawing.SelectionSets.Add("TEST")
   
    ' Export the current drawing to the file specified above.
    ThisDrawing.Export exportFile, "DXF", sset
   
End Sub

---

- alfred -

------------------
www.hollaus.at

---

Hallo Alfred

Das ist schon mal der  richtige Weg, aber das ganze funktioniert nur einmal. Beim zweiten mal bekomme ich die Fehlermeldung "Auswahlsatz bereits vorhanden".

Desweiteren wird immer die ganze Zeichnung exportiert. Es muss also irgendwie noch das SelectOnScreen eingebaut werden, ich weiss aber leider nicht wie...

Gruss, Koala

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

---

Hi,

wenn Du es ein SelectionSet schon gibt, dann kann dieses nicht neu angelegt werden, daher z.B.:

Code:

---

Dim tSSet as AcadSelectionSet
On Error Resume Next
Set tSSet = ThisDrawing.SelectionSets.Add("Test")
'und wenn dieses Selectionset namens TEST schon existiert
'  dann haetten wir hier einen Fehler, also behandeln wir diesen
If tSSet is nothing Then
  Set tSSet = ThisDrawing.SelectionSets.Item("Test")
  'und da das Selectionset schon existiert hat,
  '  koennten schon Elemente enthalten sein, also
  '  muss dieses Selectionset erst geleert werden
  tSSet.Clear
End If

---

>> Desweiteren wird immer die ganze Zeichnung exportiert

was selektierst Du denn, wenn Du bei tSSet.SelectOnScreen zur Objektwahl aufgefordert wirst? Oder könnte es sein, dass vielleicht in Deinem Code etwas passiert, das <tSSet> z.B. auf Nothing stellt?

Ich sehe jetzt Deinen Code nicht, daher sind das mal Tips a la 'ins Blaue geraten'.

- alfred -

------------------
www.hollaus.at

---

Hallo.

Mein Code sieht Momentan so aus:

Code:

---

Sub Export()

Dim exportFile As String: exportFile = "C:\DXFExprt2"
Dim tSSet As AcadSelectionSet

If tSSet Is Nothing Then
  Set tSSet = ThisDrawing.SelectionSets.Item("Test")
  tSSet.Clear
Else
  Set tSSet = ThisDrawing.SelectionSets.Add("Test")
End If

tSSet.SelectOnScreen

ThisDrawing.Export exportFile, "Dxf", tSSet

MsgBox "exportiert..."
   
End Sub

---

Ich markiere z.B. mehrere Linien und Kreise, aber es wird immer noch die ganze Zeichnung exportiert...

Gruss, Koala

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

---

Hi Koala,

Zitat:

---

    ' Note that a valid selection set must be provided, even
    ' though the contents of the selection set are ignored.

---

Das sagt ja auch aus, das die Inhalte von Selectionsets beim dem Export ignoriert werden. Daher wird auch alles exportiert.

Da haben die sich mal wieder was schönes zusammengestrickt bei Adesk.

Wenn du nicht alle Elemente exportieren willst, musst du wohl auf die WBlock-Methode ausweichen.

Gruß, Carsten

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

---

Hallo Carsten

Mit diesem Satz habe ich mich auch schon auseinander gesetzt. Meine Englisch Kenntnisse sind zwar nicht die besten, aber ich habe den Satz wie folgt übersetzt:

Zitat:

---

Beachten Sie, dass eine gültige Auswahl erbracht werden muss, ansonsten wird der Inhalt der Auswahl ignoriert.

---

In der Export Funktion wird ja auch direkt nach dem SelectionSet gefragt... Wahrscheinlich wird die von mir getroffene Auswahl noch nicht richtig erkannt.

Gruss, Koala

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

---

Hi,

heute ist scheinbar nicht mein Tag, meine Hilfe sagt (über .Export) dies:

SelectionSet object; input-only
For WMF, SAT, and BMP formats, the selection set specifies the objects to be exported. For EPS and DXF formats, the selection set is ignored and the entire drawing is exported.

Also dann doch wieder zurück zu WBLOCK, die resultierende DWG dann öffnen und speichern als DXF.

Sorry, - alfred -

------------------
www.hollaus.at

---

Hallo.

Ok. Mit der Export Funktion scheint das wirklich nicht zu gehen 
Also muss ein anderer Weg her. Der Weg über den Block ist mir zu umständlich.
Ich hab da schon ne andere Idee...

Ich möchte nun per VBA den dxfout Befehl der Kommandozeile nutzen. Der Befehl dafür ist:

Code:

---

ThisDrawing.SendCommand "dxfout" & vbCr

---

Wie bekomme ich aber nun per VBA hin das sich nicht das "speichern unter" Fenster öffnet, sondern der Befahl in der Kommandozeile bleibt?

Gruss, Koala

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

---

Hi,

Variable 'FILEDIA' vorher auf 0 stellen und dann wieder auf 1 stellen.

- alfred -

------------------
www.hollaus.at

---

Hallo

Habe es jetzt Dank eurer Hilfe geschafft. Vielen Dank
Ist vielleicht nicht der beste Weg, aber es funktioniert einwandfrei...

Hier der Code:

Code:

---

Sub Export()

Dim SSet As AcadSelectionSet
Set SSet = ssetGen("Auswahl")
SSet.SelectOnScreen

ThisDrawing.SendCommand "filedia 0 dxfout C:\Exportfile" & vbCr & "O Vorher  "
ThisDrawing.SendCommand "filedia 1 "
   
End Sub

---

Gruss Koala

------------------
Geht nicht, gibt es nicht...

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

---

Hallo

Damit das ganze auch wirklich funktioniert gehört noch ne Funktion dazu.
Das hatte ich ganz vergessen...

Code:

---

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

---

Gruss, Koala

------------------
Geht nicht, gibt es nicht...

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

---

Hi,

na dann gratuliere, zwei kleine Anmerkungen sei mir trotzdem erlaubt:

A) In Deiner Routine suchst Du nur die bestehenden SelectionSets durch, gibt es das SelectionSet mit dem gewünschten Namen aber noch nicht, wird es auch nicht angelegt (und Dein Progi fliegt ab bei SSet.SelectOnScreen)!

B) Und gibt es das SelectionSet bereits, dann kann es Dir passieren, dass bereits zuvor gewählte Elemente drin sind, wenn Du nicht dieses zuvor machst:

  ss.Clear

Möglicherweise wird bei SelectOnScreen sowieso vorher geleert (hab ich jetzt noch probiert), es empfiehlt sich, das für SelectionSets immer vor einer neuen Auswahl zu machen.

- alfred -

------------------
www.hollaus.at

---

Hallo Alfred.

Vielen Dank für Deine Anmerkungen.
Ich habe das ganze aus Codeschnipseln die ich im Netz gefunden habe "zusammengebastelt", daher bin ich für jeden Tip dankbar der den Code sicher am laufen hält.
Wie müsste der Code denn sein, damit es stabil läuft?

Gruss, Koala

------------------
Geht nicht, gibt es nicht...

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

---

Hi,

schau Dir meinen Beitrag von 14:15 an, da siehst Du, wie versucht wird, ein SelectionSet neu zu erstellen, und sollte dieses schon existieren, dann Inhalt leeren und wieder verwenden.

- alfred -

------------------
www.hollaus.at

---

Hallo
ich weiß der beitrag ist schon sehr alt, aber ich hoffe, ihr könnt mir weiterhelfen...

ich habe mir aus diversen Schnipsel einen Code zusammengestöpselet, der mir das dxf erstellen soll, vorher ein paar daten aus dem block auslesen usw. funktioniert auch alles wunderbar, auch das mit dem erstellen der datei, das problem ist nur, dass die Datei leer ist.
vielleicht findet ihr den fehler. im prinzip ist es nicht notwendig, den block noch mals auszuwählen, es würde reichen, wenn die gesamte zeichnungsdatei als dxf - WICHTIG als ACAD 2000 oder älter DXF - gespeichert wird. einfach eine dumme strichzeichnung ohne schnickschnack (brauch ich für Laser-übergabe).
NACHTRAG: die Exportierte dxf wäre toll wenn die quasi mit expresstools - BURST "behandelt" wurde, der dwg-Ursprung soll aber nicht verändert werden.... zu deutsch: ich habe meinen Dyn. block, den exportiere ich in eine dumme strich/text-dxf, der dyn.block bleibt aber unverändert in der dwg.

hier mal der Code:

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 SSet As AcadSelectionSet
    'Set SSet = ThisDrawing.SelectionSets.Add("" & pos & "_" & mat & "_" & anz & " Stk")
    Set SSet = ssetGen("Auswahl")
    SSet.SelectOnScreen 'Auswählen des Blocks
MsgBox "bis da her passts 6", vbOKOnly

    If Dir("C:\DXF-Export", vbDirectory) = "" Then MkDir ("C:\DXF-Export")
    Select Case mat
        Case 2
            MsgBox "Material =" & mat, vbOKOnly
            If Dir("C:\DXF-Export\20", vbDirectory) = "" Then MkDir ("C:\DXF-Export\20")
            'exportFile = "C:\DXF-Export\20"
            'ThisDrawing.Export exportFile, "DXF", SSet
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\20\" & pos & "_" & mat * 10 & "_" & anz & " Stk" & vbCr
            ThisDrawing.SendCommand "filedia 1 "
        Case 0.75
            MsgBox "Material =" & mat, vbOKOnly
            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 & "_" & anz & " Stk" & vbCr
            ThisDrawing.SendCommand "filedia 1 "
        Case 1
            MsgBox "Material =" & mat, vbOKOnly
            If Dir("C:\DXF-Export\10", vbDirectory) = "" Then MkDir ("C:\DXF-Export\10")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\10\" & pos & "_" & mat & "_" & anz & " Stk" & vbCr
            ThisDrawing.SendCommand "filedia 1 "
        Case 0.5
            MsgBox "Material =" & mat, vbOKOnly
            If Dir("C:\DXF-Export\5", vbDirectory) = "" Then MkDir ("C:\DXF-Export\5")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\5\" & pos & "_" & mat & "_" & anz & " Stk" & vbCr
            ThisDrawing.SendCommand "filedia 1 "
        Case 1.5
            MsgBox "Material =" & mat, vbOKOnly
            If Dir("C:\DXF-Export\15", vbDirectory) = "" Then MkDir ("C:\DXF-Export\15")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\1,5\" & pos & "_" & mat & "_" & anz & " Stk" & vbCr
            ThisDrawing.SendCommand "filedia 1 "
        Case Else
            MsgBox "Material =" & mat, vbOKOnly
            If Dir("C:\DXF-Export\", vbDirectory) = "" Then MkDir ("C:\DXF-Export\")
            ThisDrawing.SendCommand "filedia 0 dxfout C:\DXF-Export\" & pos & "_" & mat & "_" & anz & " Stk" & vbCr
            ThisDrawing.SendCommand "filedia 1"
    End Select
    SSet.Clear
    ThisDrawing.SendCommand "filedia 1"
   
'ThisDrawing.SendCommand "filedia 0 dxfout C:\Exportfile" & vbCr & "O Vorher  "
'ThisDrawing.SendCommand "filedia 1 "
   
End Sub

---

Bin über jede hilfe dankbar!

[Diese Nachricht wurde von MichlB1003 am 12. Sep. 2013 editiert.]

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