Benvenuti nella nostra community - Visita anche il blog

Benvenuto ospite! Login Registrati

Benvenuto/a ospite! . Per leggere i contenuti del forum non è richiesta la registrazione ma se vuoi interagire con noi ponendo domande ed avendo una risposta ai tuoi problemi devi registrarti. La registrazione è gratuita e puoi farla cliccando su Registrati in alto a destra, oppure entrando con i tuoi account social.


Valutazione discussione:
  • 0 voto(i) - 0 media
  • 1
  • 2
  • 3
  • 4
  • 5
lisp problem all on layer 0 preserve properties
#1
i have this lisp but don't work

Codice:
;;  BN0.lsp [command name the same]
;;    = change all Block Entities [other than on Layer Defpoints] in selected Blocks'
;;    definitions, including in any Nested Blocks, to Layer 0 with Color & Linetype
;;    overrides from entity's source layer properties [if not otherwise overridden]
;;  Kent Cooper, last edited 4 November 2014

(vl-load-com)
(defun C:BN0 (/ *error* nametolist doc blkss inc blokobj blkname blknames ent edata ldata)

 (defun *error* (errmsg)
   (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
     (princ (strcat "\nError: " errmsg))
   ); if
   (vla-endundomark doc)
   (princ)
 ); defun - *error*

 (defun nametolist (blk / blkobj blkname); get Block name and put it into list of names
   (if (= (logand (cdr (assoc 70 (entget blk))) 4) 0) ; not an Xref
     (progn
       (setq
         blkobj (vlax-ename->vla-object blk)
         blkname
           (vlax-get-property blkobj
             (if (vlax-property-available-p blkobj 'EffectiveName) 'EffectiveName 'Name)
               ; to work with older versions that don't have dynamic Blocks
           ); ...get-property & blkname
       ); setq
       (if
         (not (member blkname blknames)); name not already in list
         (setq blknames (append blknames (list blkname))); then -- add to end of list
       ); if
     ); progn
   ); if
 ); defun -- nametolist

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc); = Undo Begin

 (if (setq blkss (ssget '((0 . "INSERT")))); User selection of any number of Blocks/Minserts/Xrefs
   (progn; then
     (repeat (setq inc (sslength blkss)); list of Block names from top-level selection
       (nametolist (ssname blkss (setq inc (1- inc))))
     ); repeat
     (while (setq blk (car blknames)); as long as there's another Block name in list
       ;; [this way instead of via (repeat) or (foreach), so it can add Nested Blocks' names to list]
       (setq ent (tblobjname "block" blk)); Block definition as entity
       (if (= (logand (cdr (assoc 70 (entget ent))) 4) 0) ; not an Xref
         (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
           (setq edata (entget ent))
           (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
           (if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints
             (progn ; then
               (setq ldata (entget (tblobjname "layer" (cdr (assoc 8 edata))))); entity's Layer's properties
               (if
                 (or ; [no Color override]
                   (not (assoc 62 edata)); Bylayer
                   (member '(62 . 0) edata); Byblock
                 ); or
                 (setq edata (append edata (list (assoc 62 ldata)))); then -- assign Layer's color
               ); if
               (if
                 (and
                   (or ; [no Linetype override]
                     (not (assoc 6 edata)); Bylayer
                     (member '(6 . "ByBlock") edata)
                   ); or
                   (not (member '(6 . "Continuous") ldata))
                     ; don't override ByLayer/ByBlock with Layer's linetype if Continuous
                 ); and
                 (setq edata (append edata (list (assoc 6 ldata)))); then -- assign Layer's linetype
               ); if
               (setq edata (subst '(8 . "0") (assoc 8 edata) edata)); to Layer 0
               (entmod edata)
             ); progn -- then
           ); if -- not on Defpoints
         ); while -- sub-entities
       ); if
       (setq blknames (cdr blknames)); take first Block name off list
     ); while
     (command "_.regen")
   ); progn
   (prompt "\nNo Block(s) selected."); else
 ); if [user selection]
 (vla-endundomark doc); = Undo End
 (princ)
); defun

(prompt "\nType BENL0CL to change all selected Blocks' Entities to Layer 0 retaining their Layers' color/linetype.")
Cita messaggio
Thanks given by:




Utenti che stanno guardando questa discussione:
1 Ospite(i)