Hello everyone,
I need your help because I just don't know what to do anymore.
I wrote a LISP program, which should loop through all my blocks in a drawing (dynamic and non-dynamic) and write some infos in a CSV-file.
So far so good...
And here starts the trouble, I hope I can explain it:
There are about 50 blocks in the drawing (most non-dynamic), which may also contain blocks (and maybe some more nested blocks, also a mix of dynamic & non-dynamic)
My program starts by selecting all blocks and loops through them.
In "ProcessBlockAndSubBlocks " I check if the block is dynamic and starts with "Bohrung" or "Gewinde" => if yes get the Infos and write it to CSV...
Here is my first problem: The main block may be for example on z-Coordinate 264, but I get the z-Coordinate for the nested Block in the block which is 0 (?)
First question: How can I get the global z-coordinate from the nested-blocks
Second problem - I tried to make a recursive loop so I can also search through nested blocks in my blocks.
It works for two time nested blocks, but I don't get all informations from my first level block...
Here is my code
Code:
(defun CheckDynamicBlock (blk)
(setq props (vlax-invoke blk 'GetDynamicBlockProperties))
(if props
t ; Block ist dynamisch
nil ; Block ist nicht dynamisch
)
)
(defun ProcessBlockAndSubBlocks (blk outfile orgblk)
(setq orgblkname (vla-get-effectivename orgblk))
;(alert (strcat "orgblkname" orgblkname))
(setq blkname (vla-get-effectivename blk))
;(alert (strcat "blkname" blkname))
(if (and (or (equal (strcase (substr blkname 1 7)) "BOHRUNG") (equal (strcase (substr blkname 1 7)) "GEWINDE")) (CheckDynamicBlock blk)) ; Überprüfen, ob der Name mit "Bohrung" oder "Gewinde" beginnt und ob der Block dynamisch ist
(progn
(setq propnames-list '()) ; Ein leeres Array für die propnames erstellen
(setq propvalues-list '()) ; Ein leeres Array für die propvalues erstellen
(setq direction-x-value nil) ; Variable für Richtung X initialisieren
(setq direction-y-value nil) ; Variable für Richtung Y initialisieren
(setq propnames-list (cons "Dateiname" propnames-list)) ; Dateiname dem Array hinzufügen
(setq current-filename (getvar "dwgname"))
(setq propvalues-list (cons current-filename propvalues-list)) ; Dateiname dem Array hinzufügen
(setq blkname (vla-get-effectivename blk))
(setq propnames-list (cons "Name" propnames-list)) ; Blockname dem Array hinzufügen
(setq propvalues-list (cons blkname propvalues-list)) ; Blockname dem Array hinzufügen
(setq inspnt (vlax-safearray->list(vlax-variant-value(vlax-get-property blk 'InsertionPoint))))
(setq propnames-list (cons "Position X" propnames-list)) ; Position X dem Array hinzufügen
(setq x (car inspnt)) ; Position X
(setq x (format-value x))
(setq propvalues-list (cons x propvalues-list)) ; Position X dem Array hinzufügen
(setq propnames-list (cons "Position Y" propnames-list)) ; Position Y dem Array hinzufügen
(setq y (cadr inspnt)) ; Position Y
(setq y (format-value y))
(setq propvalues-list (cons y propvalues-list)) ; Position Y dem Array hinzufügen
(setq propnames-list (cons "Position Z" propnames-list)) ; Position Z dem Array hinzufügen
(setq z (caddr inspnt)) ; Position Z
(setq z (format-value z))
(setq propvalues-list (cons z propvalues-list)) ; Position Z dem Array hinzufügen
(setq props (vlax-invoke blk 'GetDynamicBlockProperties)) ; auslesen der dynamischen Eigenschaften
(foreach prop props
(setq propname (vla-get-propertyname prop))
(cond (
(member propname '("Ebene" "bisEbene" "Winkel" "Länge" "Gewindelänge" "Kernlochtiefe" "Drehung" "Richtung X" "Richtung Y"))
(setq propvalue (vlax-variant-value (vla-get-value prop)))
(if (or (numberp propvalue) (equal propname "Winkel"))
(progn
(if (equal propname "Drehung")
(setq propvalue (* (/ propvalue pi) 180)))
(if (equal propname "Winkel")
(setq propvalue (rtos (atof propvalue) 2 8)) ; Wandelt den Wert von "Winkel" in eine Zahl um und ergänzt acht Nachkommastellen
(setq propvalue (rtos propvalue 2 8))) ; Begrenzt auf maximal acht Nachkommastellen
(setq propvalue (format-value (atof propvalue)))
)
(setq propvalue (strcat propvalue)) ; Sicherstellen, dass propvalue eine Zeichenkette ist
)
(setq propnames-list (cons propname propnames-list)) ; propname dem Array hinzufügen
(setq propvalues-list (cons propvalue propvalues-list)) ; propvalue dem Array hinzufügen
;; Überprüfen und Zuweisung für Richtung X und Richtung Y
(if (equal propname "Richtung X")
(setq direction-x-value propvalue)
(if (equal propname "Richtung Y")
(setq direction-y-value propvalue)
)
)
)
)
)
(setq propnames-list (cons "Position RX" propnames-list)) ; Position RX dem Array hinzufügen
(setq pos-rx (+ (atof x) (atof direction-x-value))) ; Neue X-Position berechnen
(setq pos-rx (format-value pos-rx))
(setq propvalues-list (cons pos-rx propvalues-list)) ; Position RX dem Array hinzufügen
(setq propnames-list (cons "Position RY" propnames-list)) ; Position RY dem Array hinzufügen
(setq pos-ry (+ (atof y) (atof direction-y-value))) ; Neue Y-Position berechnen
(setq pos-ry (format-value pos-ry))
(setq propvalues-list (cons pos-ry propvalues-list)) ; Position RY dem Array hinzufügen
(setq propnames-list (cons "Position RZ" propnames-list)) ; Position RZ dem Array hinzufügen
(setq pos-rz (atof z)) ; Z-Koordinate bleibt unverändert
(setq pos-rz (format-value pos-rz))
(setq propvalues-list (cons pos-rz propvalues-list)) ; Position RZ dem Array hinzufügen
(setq export "") ; Leere Zeichenkette für den Export initialisieren
(foreach propvalue (reverse propvalues-list)
(setq export (strcat export (strcat propvalue ",")))
) ; Elemente zur Zeichenkette hinzufügen
(setq export (substr export 1 (- (strlen export) 1))) ; Letztes Komma entfernen
(write-line export outfile) ; Blocknamen, Layernamen und Koordinaten in die CSV-Datei schreiben
)
) ;ENDE DER SCHLEIFE, WENN ES SICH UM EINEN DYNAMISCHEN BLOCK HANDELT UND DIESER IN DIE CSV EINGETRAGEN WERDEN SOLL
(if (and (not (or (equal (strcase (substr blkname 1 7)) "BOHRUNG") (equal (strcase (substr blkname 1 7)) "GEWINDE"))) (not (CheckDynamicBlock blk)))
; wenn der Block nicht mit Gewinde oder Bohrung beginnt UND NICHT dynamisch ist, dann überprüfe, ob der Block noch Blöcke enthält
(progn
(if (setq ent (tblobjname "block" blkname))
(progn
; (if (setq ent (tblobjname "block" orgblkname))
; (setq orgblkname (vla-get-effectivename orgblk))
(while (and ent (setq ent (entnext ent)))
(if (= (cdr (assoc 0 (entget ent))) "INSERT") ; Überprüfen, ob es sich um ein Insert-Objekt (Block) handelt
(progn
(setq subblk (vlax-ename->vla-object ent))
(setq sblkname (vla-get-effectivename subblk))
; (alert (strcat "sblkname" sblkname))
(prompt (strcat "\n" "-" orgblkname "-" sblkname "-" (cdr (assoc 0 (entget ent)))))
(ProcessBlockAndSubBlocks subblk outfile orgblk)
)
)
)
))
)
)
)
(defun c:listtocsv ()
;(alert "JA")
(setq dwgpath (getvar "DWGPREFIX")) ; Pfad zur DWG-Datei
(setq dwgname (getvar "DWGNAME")) ; Name der DWG-Datei ohne Erweiterung
(setq csvpath (strcat dwgpath dwgname ".csv")) ; Pfad zur CSV-Datei
(setq outfile (open csvpath "w")) ; Öffne die CSV-Datei im Schreibmodus
(setq headlines '("Dateiname" "Name" "Position X" "Position Y" "Position Z" "Ebene" "bisEbene" "Winkel" "Länge" "Gewindelänge" "Kernlochtiefe" "Drehung" "Richtung X" "Richtung Y" "Position RX" "Position RY" "Position RZ"))
(if outfile
(progn
(write-line (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) headlines)) outfile) ; Überschrift in die CSV-Datei schreiben
(setq ss (ssget "X" '((0 . "INSERT")))) ; Alle Blöcke auswählen
(if ss
(progn
(setq numobjs (sslength ss))
(setq i 0)
(while (< i numobjs)
(setq ent (ssname ss i))
(setq blk (vlax-ename->vla-object ent))
(ProcessBlockAndSubBlocks blk outfile blk)
(setq i (1+ i))
)
)
)
(close outfile) ; CSV-Datei schließen
(princ (strcat "Blocknamen und Koordinaten wurden in die Datei " csvpath " geschrieben."))
)
(princ "Fehler beim Öffnen der CSV-Datei.")
)
(princ)
)
(defun format-value (value)
(setq original-value value)
(setq decimal-point-pos (vl-string-search "." (rtos value 2 10)))
(if decimal-point-pos
(progn
(setq length-to-fill (- 10 decimal-point-pos))
(setq value (strcat (rtos value 2 10) (substr "00000000" 1 length-to-fill))))
(setq value (strcat (rtos value 2 10) ".00000000")))
;; Kürzen auf maximal acht Stellen nach dem Punkt
(setq decimal-point-pos (vl-string-search "." value))
(if decimal-point-pos
(progn
(setq integer-part (substr value 1 decimal-point-pos)) ; Alle Zeichen vor dem Punkt
(setq decimal-part (substr value (+ decimal-point-pos 2) 8)) ; +2, um den Punkt zu überspringen
(setq value (strcat integer-part "." decimal-part))
)
)
value
)
I attached my test drawing, which contains some of my blocks for testing.
Thanks to everyone who takes time to help me.
Kind regards,
René