JRYG_CAD 发表于 2022-10-27 19:39:58

图块归入0层

图块归入0层.lsp

kucha007 发表于 2022-10-27 23:59:13

本帖最后由 kucha007 于 2022-10-28 00:02 编辑

正好最近在学习Visual Lisp，练习一下~
(defun C:B2L (/ Doc LayLst Old_Cmd Lst1)
(vl-load-com)
(setq Old_Cmd (getvar "cmdecho"))(setvar "cmdecho" 0)   
(setq Doc    (vla-get-ActiveDocument (vlax-get-acad-object))
      LayLst (vla-get-layers Doc)
)
(vla-startundomark Doc) ;记录编组
    (vlax-for e LayLst
      (if (= (vla-get-lock e) :vlax-true)
      (progn
          (setq LokLst (cons (vla-get-name e) LokLst))
          (vla-put-lock e :vlax-false)
      )
      )
    );临时解锁图层
    (setq Lst1 nil)
    (vlax-for blk (vla-get-blocks Doc)
      (vlax-for obj blk
      (if (= (vla-get-objectname obj) "AcDbBlockReference")
          (setq Lst1 (cons obj Lst1))
      )
      )
      (if Lst1 (foreach obj Lst1 (vla-put-layer obj "0")))
    )
    (if LokLst ;恢复图层状态
      (foreach e LokLst
      (vla-put-lock (vla-item LayLst e) :vlax-true)
      (setq LokLst nil)
      )
    )
    ;(vla-regen Doc :vlax-true)
(vla-endundomark Doc) ;结束编组
(princ "\n——★★★ 图块已移动到0图层 ★★★——")
(command "redraw")(setvar "cmdecho" Old_Cmd)(princ)
)

lxl217114 发表于 2022-10-29 13:11:07

！！！！不容易不容易！！！！！！！
4年多了楼主首次发了点广告以外的东西了

paulpipi 发表于 2022-10-28 08:22:24

挻牛，感谢分享

panliang9 发表于 2022-10-28 08:28:36

感谢分享！！！

行天下 发表于 2022-10-28 10:45:58


挻牛，感谢分享

白色微風1991 发表于 2022-10-28 12:42:02

感謝分享...................................

lxl217114 发表于 2022-10-29 13:09:23

kucha007 发表于 2022-10-27 23:59
正好最近在学习Visual Lisp，练习一下~

大佬高产了

tensir 发表于 2024-7-2 13:15:13

感谢作者的分享！

xxyyzzlg 发表于 2024-7-2 13:51:00

kucha007 发表于 2022-10-27 23:59
正好最近在学习Visual Lisp，练习一下~

块内也改至0层，就更好了
页: [1] 2
查看完整版本: 图块归入0层