批量建块，参考前辈们的代码完成的

wosiguwozai0830

kucha007 发表于 2022-11-18 16:10
巧了，我前两天刚搞了一个，互相学习哈哈。http://bbs.mjtd.com/thread-186619-1-1.html

不知道是不是我 ...

加前缀是为了方便后面批量选择，也可以不输入前缀的；选择一组图形后需要按鼠标右键，连续2次按鼠标右建退出循环。

wosiguwozai0830

;批量建块,参考http://bbs.mjtd.com/forum.php?mo ... %E9&_dsign=d48aa375，作者:htlaser
(defun c:pljk( / ss qianzui blkname)
    (setq qianzui(getstring"\n请输入块名的前缀:"))
    (while (setq ss(ssget))
         (setq blkname (vl-string-subst qianzui "华星切割" (menucmd "M=$(edtime,$(getvar,date),华星切割YYYY-MO-DD-HH-MM-SS)")))
        (emkblk ss (car(ss:boundingbox ss)) blkname)
        (setq ss nil)
    )
    (alert "批量建块完成。")
    (princ)
)
;生成普通块，来源于明经论坛
(defun emkblk (ss pt name / i)
  (entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))
  (repeat (setq i (sslength ss))    (entmake (cdr (entget (ssname ss (setq i (1- i))))))  )
  (entmake '((0 . "ENDBLK")))
  (command "_.erase" ss "")
  (entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))
)
;选择集的包围盒,返回左上角和右下角
(defun ss:boundingbox(ss / ptb minx miny maxx maxy)
    (setq ptb(mapcar '(lambda(x)(list (last(LM:boundingbox x))(cadr(LM:boundingbox x))))(sstolistf ss)))
    (setq minx(apply 'min (mapcar 'caar ptb)))
    (setq miny(apply 'min (mapcar '(lambda(x)(cadr(cadr x))) ptb)))
    (setq maxx(apply 'max (mapcar '(lambda(x)(car(cadr x))) ptb)))
    (setq maxy(apply 'max (mapcar '(lambda(x)(cadr(car x))) ptb)))
    (list (list minx maxy 0)(list maxx miny))
)
;; Bounding Box  -  Lee Mac
;; Returns the point list describing the rectangular frame bounding the supplied object.
;; obj - [vla] VLA-Object
;图形的包围点，对矩形来说，第一点为左下角点,输入参数为图元名
(defun LM:boundingbox ( ent / obj a b lst )
        (setq obj(vlax-ename->vla-object ent))
    (if
        (and
            (vlax-method-applicable-p obj 'getboundingbox)
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
            (setq lst (mapcar 'vlax-safearray->list (list a b)))
        )
        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
           '(
                (caar   cadar)
                (caadr  cadar)
                (caadr cadadr)
                (caar  cadadr)
            )
        )
    )
)
;将选择集转换成图元名表,参数选择集
(defun sstolistf(ss)
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex  ss)))
)

wosiguwozai0830

wosiguwozai0830 发表于 2022-11-18 17:15
加前缀是为了方便后面批量选择，也可以不输入前缀的；选择一组图形后需要按鼠标右键，连续2次按鼠标右建 ...

修改了下，这次应该可以了，之前是块名有问题

kucha007

wosiguwozai0830 发表于 2022-11-18 17:25
修改了下，这次应该可以了，之前是块名有问题

嗯嗯，可以批量建块了，但1秒内不能连续建块

中国梦

谢谢大佬的分享，感谢

sy78wpl

谢谢分享，非常不错！！！

依然小小鸟

不错的帖子

萝卜干

谢谢分享
贴主辛苦

lengxiaxi

感谢分享；每选择一个图形，执行一个建块；如果有多个封闭轮廓的图形，并不能同时识别为多个独立的块。

jkop

连续建块，可以套用在拆分零件和图档，相当好用！