[编程交流] LISP用于指定图层颜色

(vl-load-com)
(defun C:Lcolor ( / c x)
 (setq c 1)
 (vlax-for
   x
   (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
   (vla-put-Color x c)
   (if (eq c 255)
     (setq c 1)
     (setq c (1+ c))
   )
 )
)

(defun c:layd(/ Lst curLay fLst laySet)
 
 (setq Lst (list
'("BLDG_1695_1160C" 1)
'("Default_BASEBALL" 2)
'("Default_BASEBALL_FUTURE" 3)
'("Default_BLDG_1695_1155A" 4)
'("Default_BLDG_1695_1155B" 5)
'("Default_BLDG_1695_1160B" 6)
'("Default_BLDG_1695_1160C" 1)
'("Default_BOUNDARY" 2)
'("Default_CENTERROW" 3)
'("Default_CONINDEXDES"        4)
'("Default_CONINTERDES" 5)
'("Default_CONTEXTDES" 6)
'("Default_ESMT" 1)
'("Default_EXEDGPVMT" 2)
); end list
); end setq
 (vl-load-com)
 (foreach lay Lst
   (if
     (not
(vl-catch-all-error-p
  (setq curLay(vl-catch-all-apply 'vla-Item
     (list(vla-get-Layers
             (vla-get-ActiveDocument
                  (vlax-get-acad-object)))(car lay))))))
     (progn
(vla-put-Color curLay(cadr lay))
(setq fLst(list(cons 8(vla-get-Name curLay))))
(if
  (setq laySet(ssget "_X" fLst))
  (progn
    (foreach itm
             (mapcar 'vlax-ename->vla-object 
                      (vl-remove-if 'listp 
                        (mapcar 'cadr(ssnamex laySet))))
      (vla-put-Color itm acByLayer)
    ); end foreach
  ); end if
); end progn
   ); end progn
 ); end if
); end foreach
 (princ)
 ); end of c:layd

(defun c:pumat(/ Lst sSet mLst cMat sCnt lCnt mCnt eCnt)
(vl-load-com)
 
 (setq Lst (list
       '("0" "Global")
       '("Layer1" "Material 1")
       '("Layer2" "Material 2")
     ); end list
           ); end setq
 (vl-load-com)
 
(if(setq sSet(ssget "_X" '((0 . "*SOLID"))))
 (progn
   (setq sCnt 0 lCnt 0)
   (vlax-for mat (vla-get-Materials
           (vla-get-ActiveDocument
             (vlax-get-acad-object)))
     (setq mLst(cons(vla-get-Name mat)mLst))
     ); end vlax-for
   (foreach itm
       (mapcar 'vlax-ename->vla-object 
         (vl-remove-if 'listp 
           (mapcar 'cadr(ssnamex sSet))))
      (if(setq cMat
                (cadr
                  (assoc
                    (setq cLay(vla-get-Layer itm))Lst)))
        (if(member cMat mLst)
          (if(vl-catch-all-error-p
               (vl-catch-all-apply 'vla-put-Material
                 (list itm cMat)))
            (setq lCnt(1+ lCnt))
            (setq sCnt(1+ sCnt))
            ); end if
          (if(not(member cMat mCnt))
           (setq mCnt(cons cMat mCnt))
            ); end if
          ); end if
        (if(not(member cLay eCnt))
          (setq eCnt(cons cLay eCnt))
          ); end if
       );end if
    ); end foreach
   (if(or(/= 0 lCnt)(/= 0(length mCnt))(/= 0(length eCnt)))
     (progn
(princ "\n========================= ERROR LIST =========================\n")
(if(/= 0(length mCnt))
  (progn
    (princ "\nFollowing materials missed in drawing: \n")
    (foreach mat mCnt
      (princ(strcat "\n " mat))
      ); end foreach
    (princ "\n")
    ); end progn
  ); end if
      (if(/= 0(length eCnt))
  (progn
    (princ "\nSome solid layers missed in list: \n")
    (foreach lay eCnt
      (princ(strcat "\n " lay))
      ); end foreach
    (princ "\n")
    ); end progn
  ); end if
 (if(/= 0 lCnt)
   (princ(strcat "\n" (itoa lCnt) " were on locked layer!\n"))
  ); end if
(princ "\n========================== END LIST ==========================\n")
(textscr)
); end progn
     ); end if
             (princ(strcat "\n<<< Materials are appropriated for "
              (itoa sCnt) " of "
              (itoa(sslength sSet)) " solids >>>"))
   ); end progn
 (princ "\n<!> No Solids Found <!> ")
 ); end if
 (princ)
 ); end of c:pumat