社区 › AutoLISP/Visual LISP 编程技术 › 谁有可以把所有填充，不管在哪里的，包括块里面的，各种样式的，统一移动到一个图层么

xj6019 发表于 2019-11-19 10:25:57

谁有可以把所有填充，不管在哪里的，包括块里面的，各种样式的，统一移动到一个图层么

本帖最后由 xj6019 于 2019-11-19 10:41 编辑

有时候需要把所有的填充，包括块里面的，各图层的，各式各样的填充，统一移动到填充图层，并将填充后置，并设置成都随层BLAYER,不知道为什么本人电脑不支持VL函数，希望用普通lisp编写的，这个我的电脑倒是能用，我自己都不知道为什么，大部分vl函数的代码   都没法加载，或者加载后不能执行，如果有知道为什么的，请告知一下好吗，谢谢

以下代码是所有对象填充后置的，如果可以，您可以在此代码的基础上加以修改


(defun c:tty (/ sortents dictlst Doc)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(vl-load-com)
(setqdoc
   (vla-get-ActiveDocument
   (vlax-get-acad-object)
   )
)
(vlax-for blockdef (vla-get-blocks doc)
    (cond
      (
       (not
   (VL-CATCH-ALL-ERROR-P
   (setq sortents
      (VL-CATCH-ALL-APPLY
      'vla-item
      (list
          (setq dict
         (vla-GetExtensionDictionary
             blockdef
         )
          )
          "ACAD_SORTENTS"
      )
      )
   )
   )
       )
      )
      ((setq sortents
      (VL-CATCH-ALL-APPLY
    'vla-AddObject
    (list dict "ACAD_SORTENTS" "AcDbSortentsTable")
      )
       )
      )
    )
    (setq lst nil)
    (vlax-for obj blockdef
      (if (= "AcDbHatch" (vla-get-objectname obj))
(setq lst (cons obj lst))
      )
    )
    (iflst
      (progn
(vla-MoveToBottom
    sortents
    (vlax-make-variant
      (vlax-safearray-fill
      (vlax-make-safearray
    vlax-vbobject
    (cons 0 (1- (length lst)))
      )
      lst
      )
    )
)

      )
    )
)
(vla-regen doc :vlax-true)
(princ)
)

panliang9 发表于 2019-11-20 09:17:47

本帖最后由 panliang9 于 2019-11-20 09:18 编辑

找到以下代码，测试可将所有填充搬运到一个图层。
复制以下代码命令行
(defun htchlay (lynm )
(or activedocument
      (setq activedocument (vlax-get-property (vlax-get-acad-object) 'activedocument))
      ); or
(or blocks
      (setq blocks (vlax-get-property activedocument 'blocks))
      ); or
(or layers
      (setq layers (vlax-get-property activedocument 'layers))
      ); or
(if (not
      (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list layers lynm)))
      ); not
    (progn
      (vlax-for x blocks
      (vlax-for n x
          (if (equal "AcDbHatch" (vlax-get-property n 'objectname))
            (vl-catch-all-apply 'vlax-put-property (list n 'layer lynm))
            ); if
          ); vlax-for
      ); vlax-for
      ); progn
    ); if
(vl-cmdf "regen")
(princ)
); defun

命令运行以下代码，将剖面线移动到层“零”，自然你可以指定其它层。
(htchlay"0")

我是本论坛一点点都不懂的搬运工，谁进来顺手把这些拼到一个命令里，最好指定的图层事先可以存在，或者不存在。

xj6019 发表于 2019-11-20 19:17:22

谢谢楼上   不过运行了好几次cad都是直接卡死了    强制关闭才行   不知道为什么最好是有个简单快捷键命令直接填充 就全部移动到填充图层（图层名就叫填充就行），我也是完全的新手，最近刚知道有lisp这么好的东西，自己对代码一窍不通   只能来这个牛牛的论坛寻找大师

xj6019 发表于 2019-11-20 19:18:49

再就是重申一下我的电脑对vl函数不感冒   几乎都不能加载运行    也不知道为什么如果有合适的代码最好不是vl函数的   谢谢

panliang9 发表于 2019-11-21 08:58:13

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85206&highlight=%CD%BC%B2%E3

xj6019 发表于 2019-11-21 13:33:24

panliang9 发表于 2019-11-21 08:58
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85206&highlight=%CD%BC%B2%E3

不好意思你给的链接太复杂没必要   而且和我的需求不相同

panliang9 发表于 2019-11-22 08:34:12

合并了一下，你试试，如果不行的话再求教坛内的高手，我只会搬运。
必须事先在图中建立目标层，在本程序中是“10”层。命令是HTC

xj6019 发表于 2019-11-24 07:22:15

谢谢，这个我试了一下，还是可以的，就是转移到填充图层后不知道怎么全部变成BLAYER

999999 发表于 2020-9-12 20:08:34

谢谢分享，顶起来，，

查看完整版本: 谁有可以把所有填充，不管在哪里的，包括块里面的，各种样式的，统一移动到一个图层么