定义块的小程序

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可以自行修改。

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

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

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

能分享的人最可爱！

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

感谢大神分享

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

能分享的人最可爱！

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

下载玩玩看看

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

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

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

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

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

谢谢

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

很好用，感谢分享

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

感谢分享感谢分享感谢分享

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

定义块的小程序

评分

相关帖子