CAD一键动态块2

sunny_8848

感谢分享，学习下

NZG36900

1111111111111111

sdh123321

xuexi学习，动态块实用性更通用

不一样地设计

感谢分享感谢分享

qq1254582201

看一看，感谢分享

htxhtx

编写能节省不少时间，牛逼！

香远益清

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

zheng209

这个正需要

zhengchuan

感谢分享感谢分享

183017064

我想看看，但是系统要求回复帖子。