(defun c:blocktausch ( / e1 e2 e3 st1 st2 blk cnt iiss iissn iiatt regenmode attreq osmode)
(setvar "cmdecho" 0)
; Referenz BLOCK angeben ....
(setq typ "" flg T)
(while (and flg (/= typ "INSERT"))
(prompt (strcat "\r-- zu tauschenden BLOCK wählen ...."))
(setq e1 (entsel))
(if e1
(progn
(setq st1 (entget (car e1)))
(setq typ (cdr (assoc 0 st1)))
(if (/= typ "INSERT")
(prompt (strcat " ### '" typ "' gewählt - nicht akzeptiert !\n"))
(setq blk (cdr (assoc 2 st1)))
)
)
(setq flg nil)
)
)
; Referenz-WBLOCK (DWG-Datei) wählen ....
(if flg
(progn
(setq wblk nil)
(while (and flg (null wblk))
(setq st1 (strcat "-- BLOCK '" blk "' tauschen mit ..."))
(setq st2 ".\\")
(if (null (member (substr st2 (strlen st2)) (list "\\" "/")))
(setq st2 (strcat st2 "\\"))
)
(setq st2 (strcat st2 blk ".dwg"))
(if (null (setq wblk (getfiled st1 st2 "dwg" 2)))
(setq flg nil)
)
)
)
)
;Auswahlsatz mit BLOCK's w„hlen lassen ....
(if flg
(progn
(prompt (strcat "--: BLOCK '" blk "' wird neudefiniert mit WBLOCK: " wblk " !\n"))
(prompt "\r-- CAD-Elemente wählen ....")
(setq sset (ssget))
(if (and sset (> (sslength sset) 0))
(progn
(setq iiss -1 cnt 0)
(setq regenmode (getvar "regenmode"))
(while (< (setq iiss (1+ iiss)) (sslength sset))
(setq e1 (ssname sset iiss))
(setq st1 (entget e1 (list "*")))
(if (and (assoc 2 st1) (= (cdr (assoc 2 st1)) blk))
(progn
(setq attreq (getvar "attreq"))
(setq osmode (getvar "osmode"))
(setq aunits (getvar "AUNITS"))
(setvar "attreq" 0)
(setvar "osmode" 0)
(setvar "aunits" 0)
(command "._ucs" "_world")
; INSERT-Element aktualisieren ....
(if (= cnt 0)
(progn
(prompt (strcat "\r-- definiere BLOCK:'" blk "' neu ....\n"))
(command "._insert" (strcat blk "=" wblk)
(list 0.0 0.0 0.0) 1.0 1.0 0.0)
(entdel (entlast))
)
)
; - AttributWerte auslesen .....
(setq attll nil)
(if (= (cdr (assoc 66 st1)) 1)
(progn
(setq e2 (entnext e1))
(while (and e2 (setq st2 (entget e2)) (/= (cdr (assoc 0 st2)) "SEQEND"))
(if (member (cdr (assoc 0 st2)) (list "ATTDEF" "ATTRIB"))
(setq attll (cons (cdr (assoc 1 st2)) attll))
)
(setq e2 (entnext e2))
)
(if attll (setq attll (reverse attll)) )
)
)
; - 'alten' BLOCK löschen ....
(entdel e1)
; - 'neuen' BLOCK einfügen ....
(command "._insert" blk (cdr (assoc 10 st1))
"XYZ" (cdr (assoc 41 st1)) (cdr (assoc 42 st1)) (cdr (assoc 43 st1))
(/ (* (cdr (assoc 50 st1)) 180.0) PI) )
; - Layer etc. aus 'altem' BLOCK bernehmen ...
(setq st2 (entget (setq e2 (entlast))))
(setq st2 (subst (cons 8 (cdr (assoc 8 st1))) (assoc 8 st2) st2))
; - EED-Infos aus 'altem BLOCK übernehmen ....
(if (assoc -3 st1)
(setq st2 (append st2 (list (assoc -3 st1))))
)
; - Werte in CAD eintragen ...
(entmod st2)
; - 'alte' AttributWerte übernehmen ....
(setq iiatt 0)
(if (= (cdr (assoc 66 st2)) 1)
(progn
(setq iissn -1 e3 (entnext e2))
(while (and e3 (setq st2 (entget e3)) (/= (cdr (assoc 0 st2)) "SEQEND"))
(if (member (cdr (assoc 0 st2)) (list "ATTDEF" "ATTRIB"))
(progn
(if (< (setq iissn (1+ iissn)) (length attll))
(entmod (subst (cons 1 (nth iissn attll)) (assoc 1 st2) st2))
)
(setq iiatt (1+ iiatt))
)
)
(setq e3 (entnext e3))
)
(entupd e3)
)
)
; Fehlerdiagnose ....
(if (> (length attll) iiatt)
(prompt (strcat "\r ## ACHTUNG: (" (itoa (- (length attll) iiatt))
") AttributWerte gehen verloren !\n"))
)
(setq cnt (1+ cnt))
(setvar "attreq" attreq)
(setvar "osmode" osmode)
(setvar "aunits" aunits)
(command "._ucs" "_prev")
)
)
)
(prompt "\r \r")
(prompt (strcat "\r--: " (itoa cnt) " BLOCK's '" blk "' geändert !\n"))
; regenerieren ....
(if (> cnt 0)
(progn
(prompt "\r-- regeneriere Zeichnung .....\n")
(command "._regen")
)
)
(setvar "regenmode" regenmode)
)
)
(setq sset nil)
)
)
(prin1)
)
Ich habe diese Datei gefungen um den Block des Schriftfeldes auszutauschen.
Der Blöcke die gegeneinander ausgetauscht werden sollen heißen immer gleich. Kann man da was ergänzen, um die Auswahl zu umgehen?
Das er also immer den Block mit namen X gegen den Block mit Namen Y von Speierort Z austauscht?
LG Bianca
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP