64 lines
2.3 KiB
Common Lisp
64 lines
2.3 KiB
Common Lisp
(defun c:mbl ( / index)
|
|
(prompt "**** Block mit Properties bilden *******")
|
|
(prompt "")
|
|
(setq auswahl-satz nil)
|
|
(setq auswahl-satz (ssget))
|
|
(setq PT0 (getpoint "\nUrsprung antippen: "))
|
|
(bl-name PT0) ; block-kennung ermitteln (in SSTBASE)
|
|
(setq index 0.0)
|
|
(while (< index (sslength auswahl-satz)) ; Anfang WHILE
|
|
(setq E (ssname auswahl-satz index)) ; Entity-Name setzen
|
|
(setq blockname (cdr (assoc 2 (entget e)))) ; BLOCKNAME ermitteln
|
|
(print blockname) ; Blockname drucken
|
|
(print E) ; und auf SCRREN anzeigen
|
|
(setq TYP (cdr (assoc 0 (entget E)))) ; Objekt-ART
|
|
(if
|
|
(and
|
|
(equal typ "INSERT") ; wenn BLOCK
|
|
(equal (cdr (assoc 66 (entget e))) 1) ; und ATTRIBUTE vorhanden
|
|
)
|
|
(progn ; dann
|
|
(einzel-attr-aendern "C" block-kennung 0) ; oberen Block „ndern
|
|
(setq OBJ1 (tblsearch "BLOCK" blockname)) ; in der Blocktabelle suchen
|
|
(setq OBJEKT (cdr (assoc -2 OBJ1))) ; n„chstes Objekt
|
|
(princ OBJ1)
|
|
(while OBJEKT ; f�r alle Objekte des Blockes
|
|
; (einzel-attr-aendern "C" block-kennung 0)
|
|
; (setq typ1 (cdr (assoc 0 (entget OBJEKT))))
|
|
(setq typ2 (cdr (assoc 2 (entget OBJEKT))))
|
|
(if (equal typ2 "C")
|
|
(entmod (subst (cons 1 block-kennung) (assoc 1 (entget OBJEKT)) (entget OBJEKT)))
|
|
)
|
|
(setq OBJEKT (entnext OBJEKT)) ; n„chstes Objekt
|
|
) ; ende WHILE f�r alle Objekte des Blockes
|
|
)
|
|
)
|
|
(setq index (1+ index))
|
|
) ; ende WHILE
|
|
(princ)
|
|
(mach-block PT0 "0" auswahl-satz)
|
|
(attribute-aendern "0" "2" "1" "" "" block-kennung "" "" "" "") ; in SSTBASE.LSP
|
|
(setq auswahl-satz nil)
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;(defun c:blockliste (/ datei block objekt)
|
|
; (setq datei (open (strcat (getvar "DWGNAME") ".BLK") "w"))
|
|
; (setq block (tblnext "BLOCK" t))
|
|
; (while block
|
|
; (print block datei)
|
|
; (setq objekt (cdr (assoc -2 block)))
|
|
; (while objekt
|
|
; (print (entget objekt) datei)
|
|
; (setq objekt (entnext objekt))
|
|
; )
|
|
; (setq block (tblnext "BLOCK"))
|
|
; )
|
|
; (close datei)
|
|
; (princ)
|
|
;)
|
|
|