Mehrfachauswahl von Blöcken, um die Linie auf Eigenschaften von Block zu platzieren

[jim78b]

ciao chiedo a voi che siete esperti, io ho questo lisp che mette l'oggetto selezionato (blocco) su by block. tranne che vorrei quando chiede di selezionare l'elemento di selezione tramite finestra più elemente e non solo ANHANG


; Dateiname: fixblock.lsp
; Beschreibung: legt alle Blöcke Untereinheiten auf Schicht 0 mit Farbe und
; Linetype auf Byblock gesetzt. der Block, selbst, wird auf
; seine ursprüngliche Schicht.
;
; Revision:
; 3-dec-2003 yz
; Programm geändert, um von einem Keyword auf der Befehlszeile zu arbeiten
****************************************************************************************************************************************************************************************************************************************************************
(defun d_fixblock (/ eblocksel)
linsertdata; Unternehmensdaten
sblockname ; blockname
lblockdata
Esubentity
lsubdata ; Sub-entity-Daten
icount; Zähler
)

;; redefine fehler handler

(setq)
*error *error*
*error* d_fb_error
;_ Endsatz

Umwelt

(setq #sysvars (#savesysvars (list "cmdecho")))

(Setvar "cmdecho" 0)
(Befehl "._undo" "_group")

;; Holen Sie sich Block vom Benutzer und stellen Sie sicher, dass es ein Insert-Typ ist

(falls (setq eblocksel (entsel "\nselect block to change :"))
(Prog.)
(falls (setq linsertdata (entget))
(if (= (cdr (assoc 0 linsertdata)) "insert")
(setq sblockname (cdr (assoc 2 linsertdata)))
(Prog.)
(Alert "Entity ausgewählt ist kein Block!")
(Auszug)
)
;
(Prog.)
(Alert "ungültige Blockauswahl!")
(Auszug)
)
;

;; erhalten Blockinfos von der Blocktabelle

(setq)
lblockdata (tblsearch "block" sblockname)
Esubentity (cdr (assoc -2 lblockdata))
;_ Endsatz

;; stellen Sie sicher, dass Block nicht xref

(falls nicht (assoc 1 lblockdata))
(Prog.)
(princ "\nprocessing block: ")
(princ sblockname)

(princ "\nupdating block subentities. . .")

;; parse durch alle Blöcke Untereinheiten

(while esubentity)

(princ " .")
(setq lsubdata (entget esubentity))

;; update Layer Eigenschaft

(falls (assoc 8 lsubdata)
(Prog.)
(setq lsubdata
(Unterteil)
(cons 8 "0")
(assoc 8 lsubdata)
Isubdata
;
;_ Endsatz
(entmod lsubdata)
)
;

;; aktualisieren Sie die Eigenschaft Linetype

(falls (assoc 6 lsubdata)
(Prog.)
(setq lsubdata
(Unterteil)
(cons 6 "byblock")
(assoc 6 lsubdata)
Isubdata
;
;_ Endsatz
(entmod lsubdata)
)
(entmod (Append lsubdata (list (cons 6 "byblock"))))
;

;; aktualisieren Sie die Farbeigenschaft

(falls (assoc 62 lsubdata)
(Prog.)
(setq lsubdata
(Unterteil)
(cons 62 0)
(assoc 62 lsubdata)
Isubdata
;
;_ Endsatz
(entmod lsubdata)
)
(entmod (Anhang Isubdata (Liste (cons 62 0))))
;

(setq esubentity (entnext esubentity))
; nächste Sub-Entität erhalten

) Ende

;; update Attribute

(idc_fb_updattribs)

)
(Alert "xref ausgewählt. nicht aktualisiert!")
) enden, wenn
)
(Alert "nicht ausgewählt.")
) enden, wenn

;;; Pop-Fehler Stack und Reset-Umgebung

(idc_restoresysvars)

(princ "\ndone!")

(setq *error* d_#error)

(princ)

) end defun

****************************************************************************************************************************************************************************************************************************************************************
; Funktion zum Update von Blockattributen
****************************************************************************************************************************************************************************************************************************************************************
(defun idc_fb_updattribs ()

;; aktualisieren Sie alle Attribute Definitionen

(setq icount 0)

(princ "\nupdating Attributes. . .")
(wenn (setq ssinserts)
(Liste (cons 0 "Insert")
(cons 661)
(cons 2 sblockname)
;_ Endliste
;_ Ende ssget
;_ Endsatz
(Repeat)

(setq eblockname (ssname ssinserts icount))

(falls (setq esubentity (entnext eblockname))
(setq)
lsubdata (entget esubentity)
Esubtype (cdr (assoc 0 lsubdata))
;_ Endsatz
;

(while (oder (= Esubtyp "attrib") (= Esubtyp "seqend"))

;; update Layer Eigenschaft

(falls (assoc 8 lsubdata)
(Prog.)
(setq lsubdata
(Unterteil)
(cons 8 "0")
(assoc 8 lsubdata)
Isubdata
;
;_ Endsatz
(entmod lsubdata)
)
;

;; aktualisieren Sie die Eigenschaft Linetype

(falls (assoc 6 lsubdata)
(Prog.)
(setq lsubdata
(Unterteil)
(cons 6 "byblock")
(assoc 6 lsubdata)
Isubdata
;
;_ Endsatz
(entmod lsubdata)
)
(entmod (Append lsubdata (list (cons 6 "byblock"))))
;

;; aktualisieren Sie die Farbeigenschaft

(falls (assoc 62 lsubdata)
(Prog.)
(setq lsubdata
(Unterteil)
(cons 62 0)
(assoc 62 lsubdata)
Isubdata
;
;_ Endsatz
(entmod lsubdata)
)
(entmod (Anhang Isubdata (Liste (cons 62 0))))
;

(falls (setq esubentity (entnext esubentity))
(setq)
lsubdata (entget esubentity)
Esubtype (cdr (assoc 0 lsubdata))
;_ Endsatz
(setq esubtype nil)
;

) Ende

(setq icount (1+ icount))

)

) enden, wenn
(Befehl "regen")
) end defun

****************************************************************************************************************************************************************************************************************************************************************
; Funktion zum Speichern einer Liste von Systemvariablen
****************************************************************************************************************************************************************************************************************************************************************
(defun #savesysvars (lvarlist / ssystemvar)
(mapcar)
'(lambda (systemvar)
(setq lsystemvars)
(Anhang lsystemvars
(Liste ssystemvar (getvar systemvar))
;_ Endanmeldung
;_ Endsatz
;
lvarlist
;_ end mapcar

Lsystemvars

;_ end defun
****************************************************************************************************************************************************************************************************************************************************************
; Funktion zur Wiederherstellung einer Liste von Systemvariablen
****************************************************************************************************************************************************************************************************************************************************************
(defun idc_restoresysvars ()
(mapcar)
'(lambda (systemvar)
(setvar (car ssystemvar) (cadr systemvar))
;
#sysvars
;_ end mapcar
;_ end defun
****************************************************************************************************************************************************************************************************************************************************************
; Fehlerhandler
****************************************************************************************************************************************************************************************************************************************************************
(defun d_fb_error (msg)

(princ "\nerror aufgetreten in der fix block Routine...")
(princ "\nerror: ")
(princ msg)

(setq *error* d_#error)
(falls *error*)
(*error* msg)
;

(Befehl)

(falls (/= msg "quit / Exit abort")
(Prog.)
(Befehl "._undo" "_end")
(Befehl "._u")
)
;

(idc_restoresysvars)

(princ)

;_ end defun
****************************************************************************************************************************************************************************************************************************************************************

(defun c:fixblock (d_fixblock))
(princ)

 

[confutatis]

verwenden, was mir eher synthetisch erscheint. .

(Defun c:fixblock2 ()
(setq Blöcke (vla-get-Blöcke (vla-get-activedocument (vlax-get-acad-object)))
grublo (ssget '((0 . "Insert")))
ssgetblocks '()
ssgetblocks1()
)

(Repeat (setq index(sslength grublo))
(setq ssgetblocks (cons (vla-get-effektname (vlax-ename->vla-object (ssname grublo (setq index(1- index)))))))))
)

(jeder elem ssgetblocks
(falls nicht(erinnern elem ssgetblocks1))
(setq ssgetblocks1 (cons elem ssgetblocks1))
)
)

(jeder elem ssgetblocks1
(setq bloccovl(vla-item block elem)
Index 0
)

(Repeat (vla-get-count bloccovl)
(vla-put-color (vla-item bloccovl index) 0)
(vla-put-linetype (vla-item bloccovl index) "byblock")
(Satzindex (1+ Index))
)

)

(vla-regen (vla-get-activedocument (vlax-get-acad-object))))

)

 

[jim78b]

grazie grande! domani provo .

 

[jim78b]

Hi Ich versuchte Ihre Lispe, nur etwas ändert sich nicht durch Block geschachtelte Blöcke

verwenden, was mir eher synthetisch erscheint. .

(Defun c:fixblock2 ()
(setq Blöcke (vla-get-Blöcke (vla-get-activedocument (vlax-get-acad-object)))
grublo (ssget '((0 . "Insert")))
ssgetblocks '()
ssgetblocks1()
)

(Repeat (setq index(sslength grublo))
(setq ssgetblocks (cons (vla-get-effektname (vlax-ename->vla-object (ssname grublo (setq index(1- index)))))))))
)

(jeder elem ssgetblocks
(falls nicht(erinnern elem ssgetblocks1))
(setq ssgetblocks1 (cons elem ssgetblocks1))
)
)

(jeder elem ssgetblocks1
(setq bloccovl(vla-item block elem)
Index 0
)

(Repeat (vla-get-count bloccovl)
(vla-put-color (vla-item bloccovl index) 0)
(vla-put-linetype (vla-item bloccovl index) "byblock")
(Satzindex (1+ Index))
)

)

(vla-regen (vla-get-activedocument (vlax-get-acad-object))))

)