复制图块为新图块

tranney

一个小工具，可以复制图块为新图块(保留原图并新制作了个图块)
,用来快速制作底图，可能有人和我一样可以用得上


(defun c:bbs ()
        (setvar "cmdecho" 0)
        (defun xensel2 (msg f)
                (while (if (setq el (car (entsel msg)))
                                                 (if (= (cdr (assoc 0 (entget el))) f) nil t)
                                                 nil)) el
        )
        (defun ssnext (s0 / ss)
                (setq ss (ssadd))
                (while (setq S0 (entnext S0))(ssadd S0 ss))
        )
        (princ "\n图块工具，复制图块为新图块(保留原图并新制作了个图块):")
        (setq s1 (xensel2 "\n选择源图块 : 或<退出>:" "INSERT"))
        ;(setq s1 (entsel "\n选择源图块 :"))
        (setq ent (entget s1))
  (setq name (cdr(assoc 2 (entget s1))))
        (setq pt1 (cdr(assoc 10 (entget s1))))
        (princ (strcat "源图块名为：" name "\n"))
        (setq str (rtos (fix (* 1e6 (getvar 'cdate))) 2 0))        ;;时间为块名
        (princ (strcat "时间名为：" str "\n"))
        (setq name1 (strcat name str ))
        (princ (strcat "新图块名为：" name1 "\n"))
        (setq pt2 (getpoint "\n请点选 新的图块的位置:"))
        (setq s0(entlast))
        (COMMAND "copy" s1 "" pt1 pt2 )
        (setq ss1(Ssnext s0))
  (setq s0(entlast))
        (command ".EXPLODE" ss1 "")
        (setq ss2(Ssnext s0))
        (setq ss3(SSGET "p"))
        (print "\n图块制作")
        (command "block" name1  pt2 ss3 "");图块制作
        (command "insert" name1 pt2 1 1 0);插入图块
        (SETVAR "CMDECHO" 1)
        (princ)
)

CAD新军

能用。套图时局部大样改了有用。

jun353835273

有嵌套块能行吗

lllllja

jun353835273 发表于 2018-11-14 08:16
有嵌套块能行吗

试过了，不能嵌套块

my258

有用，希望改进能支持嵌套块

菜卷鱼

求助图块另存为问题
http://bbs.mjtd.com/forum.php?mo ... &fromuid=399892
(出处: 明经CAD社区)

tranney

谢谢菜卷鱼大哥

wblx

试试看

zh74

试一试看看好用不。。。。