旧图块替换为指定图块

木香 · 发表于 2020-6-11 15:05:33

;;旧图块替换为指定图块
;;可实现自动匹配图块旋转角（要求源图块的插入点在旋转中心）
(defun C:BTOB (/ *error*_bak *error*_sh ang ang1 anglst angn blk1 blk2 blk2name data dist lst n name orth os pisrt pon pt1 pt2 ptanglst ptlst ptn ss yn)
(defun *error*_sh (msg)
(setq *error* *error*_bak)
(setvar "osmode" os)
(setvar "orthomode" orth)
;(command "undo" "e")
)
(command "undo" "be")
(setq *error*_bak *error*)
(setq *error* *error*_sh)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setq orth (getvar "orthomode"))
(setq lst '())
(setq n 0)
(if (setq blk1 (car (entsel "\n选择源图块")))
(if (and (= "INSERT" (cdr (assoc 0 (entget blk1)))) (setq pt1 (getpoint "\n指定源图块基点")));源图块及基点设定
(if (setq blk2 (car (entsel "\n选择一个被替换的块")))
(if (and (= "INSERT" (cdr (assoc 0 (entget blk2)))) (setq pt2 (getpoint "\n指定被替换对象块的基点")));被替换块及基点设定
(progn
(setq blk2name (cdr (assoc 2 (entget blk2))))
(setq pisrt (cdr (assoc 10 (entget blk2))))
(setq dist (distance pisrt pt2))
(setq ang (angle pisrt pt2))
(setq ang1 (cdr (assoc 50 (entget blk2))));;以块的插入点及指定的点相对关系，确定每个将要被替换的块（以复制后删除方式实现替换）的复制第二点
(if (setq ss (ssget (list (cons 0 "INSERT") (cons 2 blk2name))))
(progn
(setq ptlst '() anglst '())
(repeat (sslength ss)
(setq name (ssname ss n))
(setq ptn (cdr (assoc 10 (entget name))))
(setq angn (cdr (assoc 50 (entget name))))
(setq pon (polar ptn (+ ang (- angn ang1)) dist))
(setq ptlst (cons pon ptlst))
(setq anglst (cons angn anglst))
(setq n (1+ n))
)
(setq ptanglst (mapcar 'list ptlst anglst));;每个被替换块的位置点+旋转角的列表
(setvar "orthomode" 0)
(setvar "osmode" 0)
(command "undo" "be")
(foreach x ptanglst
(command ".copy" blk1 "" pt1 (car x))
(setq data (entget (entlast)))
(entmod (setq data (subst (cons 50 (cadr x)) (assoc 50 data) data)));;要求原图块插入点与自身旋转中心重合
)
(princ (strcat "\n已替换" (itoa (sslength ss)) "个对象"))
(initget "Y N")
(setq yn (getkword "\n是否删除原对象[是(Y)/否(N)]:"))
(if (or (null yn) (= (strcat yn) "Y"))
(command "erase" ss "")
)
(command "undo" "e")
)
)
)
(princ "\n无效的图块或基点")
)
)
(princ "\n无效的图块或基点")
)
)
(setvar 'OSMODE os)
(setvar 'ORTHOMODE orth)
(setq *error* *error*_bak)
;(command "undo" "e")
(princ)
)

木香 · 发表于 2020-6-11 15:22:36

一个小问题，11行注释掉

pzweng · 发表于 2020-6-11 16:30:49

直接通过改组码2来替换

fengyu6913 · 发表于 2021-4-4 18:00:02

感谢分享，又捡到宝了，CAD自带的不能指定替换的范围
之前其他程序又转不了角度这个全解决了连插入点问题都考虑了

木香 · 发表于 2020-6-11 16:48:11

pzweng 发表于 2020-6-11 16:30
直接通过改组码2来替换

这个思路不错，不过不知道替换时位置能不能按需实现，空了试试

木香 · 发表于 2020-6-11 16:51:11

pzweng 发表于 2020-6-11 16:30
直接通过改组码2来替换

块可以这样操作呢？不会出现重名块覆盖？

oistre · 发表于 2020-6-11 16:51:49

不错的程序！！！

pzweng · 发表于 2020-6-11 17:15:01

木香发表于 2020-6-11 16:51
块可以这样操作呢？不会出现重名块覆盖？

可以的，我就是这样做的

e2002 · 发表于 2020-6-12 19:14:56

直接修改组码2的值即可（动态块除外）。

xsso · 发表于 2021-4-2 14:50:59

我一直在研究这个功能，但当x y 坐标为-1就会出问题，坐标和角度都要置换

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

[源码] 旧图块替换为指定图块