you_boss 发表于 2021-3-12 16:03:08

定义块的小程序

(defun emkblk (ss pt name / i)
       (print 1)
       (entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))
       (mapcar '(lambda (x) (entmake (cdr (entget x)))) ss)
       (entmake '((0 . "ENDBLK")))
       (mapcar 'entdel ss)
       (entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))
)

(defun ZB (obj / obj ss x y)
        (vla-getboundingbox obj 'x 'y)
        (setq ss (mapcar 'vlax-safearray->list (list x y)))
        (list (mapcar 'car ss) (mapcar 'cadr ss))
)


(defun c:B12 ( )
       (vl-load-com)
       (princ "\n请选择要变为块的对象")
       (setq ss (ssget))
       (setq ss1 '())
       (while (setq ent (ssname ss 0)) (setq ss (ssdel ent ss) ss1 (cons ent ss1) ) )
       (setq ss2 (mapcar 'ZB (mapcar 'vlax-ename->vla-object ss1)))
       (setq ss3 (vl-sort (apply 'append (mapcar 'car ss2)) '<) x1 (car ss3) x2 (last ss3))
       (setq ss3 (vl-sort (apply 'append (mapcar 'cadr ss2)) '<) y1 (car ss3) y2 (last ss3))
       (setq pt (mapcar '* '(0.5 0.5) (list (+ x1 x2) (+ y1 y2))))
       (setq WD (itoa (fix(- x2 x1))))
       (setq HG (itoa (fix(- y2 y1))))
       (setq NE (strcat "c" "B" WD " " "H" HG))
       (print ne)
       (setq name ne)
       (emkblk ss1 pt name)
       (princ)
)

ps；只需要框选需要定义为块的对象即可，块名为块外接最小矩形的尺寸，前缀c可以自行修改。

金鹅起飞 发表于 2023-10-5 08:39:50

谢谢楼主分享。我下载试了下，好像不能用：

“命令: b12 未知命令“B12”。按 F1 查看帮助。”

未知命令，加载后输入命令，出现这样的情况。不知为何？

season_88 发表于 2024-11-28 09:22:18

金鹅起飞 发表于 2023-10-5 08:39
谢谢楼主分享。我下载试了下，好像不能用：

“命令: b12 未知命令“B12”。按 F1 查看帮助。”


可以用的。

nsh935 发表于 2022-12-12 09:52:34

能分享的人   最可爱！

tigcat 发表于 2021-3-14 10:45:23

谢谢大侠分享另一种做块方法

xj6019 发表于 2021-3-14 13:09:49

能分享的人   最可爱！

w379106181 发表于 2021-5-23 08:50:18

感谢大神分享

linhuiu0668 发表于 2022-12-12 16:01:34

下载玩玩看看

sjl_fyl 发表于 2024-2-4 13:33:53

{:1_1:}谢谢

paulpipi 发表于 2024-2-21 10:37:30

很好用，感谢分享

yefei812678 发表于 2024-3-5 08:29:21

感谢分享感谢分享感谢分享
页: [1] 2
查看完整版本: 定义块的小程序