社区 › Auto Lisp › LISP用于指定图层颜色

ajl_mo 发表于 2022-7-6 17:31:05

LISP用于指定图层颜色

大家好，
 
我正在使用Map 3D导入大量。shp文件以设置我的基本文件。我遇到的问题是，所有的对象都带有“白色”的层颜色。通过查看图形，很难知道对象位于哪一层。
 
我的想法是一个LISP，它会为每个层指定一种颜色，可能只是前六种颜色。它最终会看起来像下面这样。。。
 
BLDG_1695_1160C——颜色1
Default_BASEBALL--颜色2
Default\u Basketball\u FUTURE--颜色3
Default_BLDG_1695_1155A--颜色4
Default_BLDG_1695_1155B--颜色5
Default\u BLDG\u 1695\u 1160B--颜色6
Default\u BLDG\u 1695\u 1160C--颜色1
默认_边界--颜色2
Default\u CENTERROW--颜色3
Default\u CONINDEXDES--颜色4
Default\u CONINTERDES--颜色5
默认_上下文--颜色6
Default\u ESMT--颜色1
Default_EXEDGPVMT--颜色2
是否有LISP将为图层指定不同的颜色？
 
提前感谢
 
托尼

rkmcswain 发表于 2022-7-6 17:36:17

你想要随机的颜色还是预定的颜色？
 
下面将为每个层指定不同的颜色（按1-255的顺序）。如果您想要随机颜色，在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))
   )
)
)

ASMI 发表于 2022-7-6 17:40:52

试试这个。必须解锁并解冻列表中的所有层。
 
(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

shamsam1 发表于 2022-7-6 17:43:11

我们可以将材质名称附加到特定层，然后使用lisp进行渲染，而不是将颜色附加到层

ASMI 发表于 2022-7-6 17:47:12

>萨姆萨1
 
已阅读您的PM：
 
(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

BIGAL 发表于 2022-7-6 17:53:53

你已经完成了3/4，也许一个脚本就可以了
 
-图层
颜色1 BLDG_1695_1160C
颜色2 Default\u BASEBALL
颜色3 Default\u Basketball\u FUTURE
颜色4 Default\u BLDG\u 1695\u 1155A
等等等等
Default_BLDG_1695_1155B--颜色5
Default\u BLDG\u 1695\u 1160B--颜色6

ASMI 发表于 2022-7-6 17:56:11

>比加尔
 
最后一个家伙想将材料附着到某些层上的实体上，你能用脚本实现吗？

shamsam1 发表于 2022-7-6 18:02:41

嗨，阿斯米，
 
谢谢你的回复。运行脚本时，显示以下错误：，
 
错误：没有函数定义：VLA-GET-MATERIALS
 
你能帮忙解决这个问题吗。
 
当做
萨姆萨1

ASMI 发表于 2022-7-6 18:03:55

哎呀！
 
让我高兴。请在文件的开头或结尾添加（vl load com）表达式。VLA函数没有它就无法工作。或者再次复制列表。我只是补充一下。

shamsam1 发表于 2022-7-6 18:08:51

在开始时添加（vl load com）后，我仍然得到相同的错误。。
我对lisp的了解是nill
 
这就是我修改的地方
 
（定义c:pumat（/Lst sSet mLst cMat sCnt lCnt mCnt eCnt）
（vl load com）
（setq Lst（列表
“（“Layer1”“APE BUMP”）
 
); 结束列表
); 结束setq
 
 
VLA-GET-MATERIALS是我再次遇到的错误

查看完整版本: LISP用于指定图层颜色