[编程交流] 外部参照操作-更改la

(defun c:xr-elec (/ sset ctr xr2 xr3 xr4 xr5 xr6 tx1 xclr ocmd llist temp1 layfzn)
; Change all the layers of an xref to specified color.
 (vl-load-com)
 (setq ocmd (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (command "_.undo" "_end")
 (command "_.undo" "_group")
 (prompt "\nSelect xref(s) to convert to ELEC: ")
 (if (setq sset (ssget))
   (progn
     (setq ctr 0)
     (repeat (sslength sset)
       (setq xr1 (ssname sset ctr))
       (if xr1
         (progn
           (setq xr2 (entget xr1))
           (setq tx1 (cdr (assoc 0 xr2)))
           (if
             (and
               (= tx1 "INSERT")
                 (setq xr3 (cdr (assoc 2 xr2)))
                    (setq xr4 (tblsearch "block" xr3))
                      (setq xr5 (cdr (assoc 1 xr4)))
                  )
             (progn
               (setq xclr 15) ;;SET LAYER COLOR
               (if (assoc 62 xr2)
                 (entmod (subst (cons 62 xclr) (assoc 62 xr2) xr2))
                 (entmod (append xr2 (list (cons 62 xclr))))
               )
               (setq xr6 (strcat xr3 "|"))
               (setq llist (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
               (vlax-for item llist
                 (if (vl-string-search xr6 (vlax-get item 'Name))
                   (progn
                     (setq temp1 (vlax-get item 'TrueColor))
                     (vlax-put temp1 'ColorIndex (rtos xclr 2 0))
              (vlax-put item 'TrueColor temp1)
                   )
                 )
                 )
        ;change all entities within xrefs to color bylayer, omitting <section,grid> nested xrefs
        (command "_.xref" "unload" "section*,grid")
               (blocksbylayer xr1)
        (command "_.xref" "reload" "section*,grid")
             )
           (prompt "\nNot an xref"))
         )
       )
     (setq ctr (1+ ctr)))
   ) (princ) 
 ) 
 (command "_.undo" "_end")
 ;freeze list of layers
 (setq layfzn "0,*|AREA,*|DIM*,*|DOOR TAG*,*|KEY NOTES,*|LINE-CENTER,*|NO PLOT,
     *|POCHE-FLOOR*,*|SYMBOL-*,*|SYMBOL_*,*|SYMBOL *,*|TEXT*,*|WINDOW TAG*,*|SECTION CUTS-96,
     *|GRID-96")
 (command "_.layer" "freeze" layfzn "")
 ;change a few specific layer colors
 (command "_.layer" "color" 13 "*|wall_shade,*|poche-roof*" "")
 (setvar "cmdecho" ocmd)
 (princ)
)
(defun blocksbylayer (xr1 / ELST ENAM ESEL BNAM FLST)
 (setq ELST (entget xr1)
       BNAM (cdr (assoc 2 ELST))
FLST nil
 )
 (fix1 BNAM)
 (vl-cmdf "regen")
 (princ)
)
(defun FIX1 (BNAM / BENAM)
 (if (not (member BNAM FLST))
   (progn
     (setq FLST  (cons BNAM FLST)
    BENAM (tblobjname "block" BNAM))
     (while
(setq BENAM (entnext BENAM))
        ;(print (entget BENAM))
       (if (= (cdr (assoc 0 (entget BENAM))) "INSERT")
         (fix1 (cdr (assoc 2 (entget BENAM))))
         (vla-put-color (vlax-ename->vla-object BENAM) 256)
       )
     )
   )
 )
)