CAD一键动态块2
本帖最后由 null. 于 2025-2-18 15:23 编辑自己持续研究，终于搞定，可一键生成动态块！敬请关注！
用LSP代码写：
**** Hidden Message *****
本帖最后由 kozmosovia 于 2025-2-18 15:46 编辑
用一堆command实现，图形小时还好，图形大时，来回切换显示会比较晃眼睛的。不过的确在VLISP下，也没有其他的方式。
应该直接定义好可见性里面可见的图块，然后用块名代替可见性状态01234，更好的识别。
本帖最后由 香远益清 于 2025-3-6 10:10 编辑
这个功能10几年前就在该站上有源代码了，还用大家花钱？我给一个，如下：
;;;【命令：KSJK】快速建块;;
(vl-load-com)
(defun Makeunnameblk (entss / boundingbox pois cenpoi)
(defun boundingbox (ss / i ent obj pta ptb dwcorn upcorn ptlist x y)
(setq i 0
dwcorn nil
upcorn nil
)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(vla-GetBoundingBox obj 'pta 'ptb)
(setq dwcorn (cons (vlax-safearray->list pta) dwcorn))
(setq upcorn (cons (vlax-safearray->list ptb) upcorn))
(setq i (1+ i))
)
(setq ptlist (append dwcorn upcorn))
(setq x (mapcar 'car ptlist))
(setq y (mapcar 'cadr ptlist))
(list (list (apply 'min x) (apply 'min y))
(list (apply 'max x) (apply 'max y))
)
)
(if entss
(progn
(setq pois (boundingbox entss))
(command"cutclip" entss "")
(command"pasteblock" (car pois))
)
)
(command "change" (entlast) "" "P" "la" "0" ""
"change" (entlast) "" "P" "c" "bylayer" "")
;给块重命名
(setq ent (entget (entlast)))
(setq name (cdr (assoc 2 ent))) ;取得块名name
(setq blkname (strcat "K_" (rtos (* (getvar "cdate") 1e8))));给块名设定时间
(command "-rename" "b" name blkname)
(princ (strcat "\n新图块 <" blkname "> 绘制完成. "))
)
(defun c:KSJK(/ entss)
(princ "快速建块(块基点为左下点）")
(setq entss (ssget))
(makeunnameblk entss)
(princ)
)
;;;========================END=====================;; 用处不大 这个代码用AI写的吧 学习一下，感谢分享 顶一个，期待中 看一看，感谢分享 很好→很棒！很好~很棒！！很好……很棒！！！ 谢谢分享！学习一下！ 谢谢分享了 感谢分享 感谢分享