木香 发表于 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就会出问题，坐标和角度都要置换
页: [1] 2
查看完整版本: 旧图块替换为指定图块