图块归入0层

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

图块归入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)
)

(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层，就更好了

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

[源码] 图块归入0层

本帖子中包含更多资源

评分