把所有的实体移动到0层，颜色设置为bylayer

marting · 发表于 2016-12-25 15:19:42

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(vl-load-com)
(defun c:COMBINELAYERS(/ doc blocks blk eo layers lay)
;CHANGE BY LAYER COLOR TO OVERRIDE COLOR 
  ;; Get the ActiveX object of the current dwg
  (setq doc    (vla-get-ActiveDocument (vlax-get-acad-object))
        blocks (vla-get-Blocks doc) ;Get the blocks collection
        layers (vla-get-Layers doc) ;Get the layers collection
  ) ;_ end of setq

  ;; Step through all blocks (including Model Space & Layouts)
  (vlax-for blk blocks
    ;; Step through all contained entities in block
    (vlax-for eo blk
      ;; Get the layer the entity is placed on
      (setq lay (vla-Item layers (vla-get-Layer eo)))
      (vla-put-Layer eo (getvar "CLAYER")) ;Change the entity to the current layer
      (if (= (vla-get-Color eo) 256)
        ;;If its colour bylayer, change it to overridden color to match
        (vla-put-Color eo (vla-get-color lay))
      ) ;_ end of if
      (if (= (strcase (vla-get-Linetype eo)) "BYLAYER")
        ;;If its linetype bylayer, change it to overridden linetype to match
        (vla-put-Linetype eo (vla-get-Linetype lay))
      ) ;_ end of if
      (if (= (vla-get-Lineweight eo) -1)
        ;;If its lineweight bylayer, change it to overridden lineweigth to match
        (vla-put-Lineweight eo (vla-get-Lineweight lay))
      ) ;_ end of if
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for
  (princ)
) ;_ end of defun

cable2004 · 发表于 2016-12-25 19:03:10

啥也不说了，感谢楼主分享哇！

HLCAD · 发表于 2016-12-26 08:03:37

非常好的程序，感谢楼主分享。

空静 · 发表于 2016-12-26 10:38:51

十分的感谢，多谢

sicky111 · 发表于 2017-1-26 23:19:56

谢谢分享。

liunian0524 · 发表于 2017-9-12 17:23:16

本帖最后由 liunian0524 于 2017-9-12 17:30 编辑

感谢楼主分享,如果点样式修改了的话,会出现如图:(图块里面的标注)

账号		自动登录	找回密码
密码			立即注册

[每日一码] 把所有的实体移动到0层，颜色设置为bylayer

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。