CAD一键动态块2

null.

自己持续研究，终于搞定，可一键生成动态块！敬请关注！
用LSP代码写：
原讨论贴：一键生成动态块
http://bbs.mjtd.com/forum.php?mo ... 1&extra=#pid1008261
传上来怕被反译！源码直接收币。


V4.15补丁下T30天正软件V1.0互联版及(个人版)

kozmosovia

用一堆command实现，图形小时还好，图形大时，来回切换显示会比较晃眼睛的。不过的确在VLISP下，也没有其他的方式。

应该直接定义好可见性里面可见的图块，然后用块名代替可见性状态01234，更好的识别。

香远益清

这个功能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=====================;;

429014673

用处不大                  

ssyfeng

这个代码用AI写的吧

bloodtempt

学习一下，感谢分享

lingduwx

顶一个，期待中

cqu20104225

看一看，感谢分享

寒潮大冬瓜

很好→很棒！很好~很棒！！很好……很棒！！！

nsh935

谢谢分享！学习一下！

lxl217114

谢谢分享了

pizi158545086

感谢分享 感谢分享