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

xj6019

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

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


(defun c:tty (/ sortents dict  lst Doc)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(vl-load-com)
  (setq  doc
   (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))
      )
    )
    (if  lst
      (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

找到以下代码，测试可将所有填充搬运到一个图层。
复制以下代码命令行
(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

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

xj6019

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

panliang9

http://bbs.mjtd.com/forum.php?mo ... hlight=%CD%BC%B2%E3

xj6019

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

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

panliang9

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

xj6019

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

999999

谢谢分享，顶起来，，