[编程申请]：将被选择的块替换成指定的块

lengliqun

求程序，将被选择的块替换成指定的块：
CAD图形中有多个名为“123”“456”的块，同时在这个CAD图中有名为“ABC”的块(若这个CAD图中无名为“ABC”的块，则
CAD的搜索目录下有个名为“ABC.DWG”文件)。运行您的程序后，选择名为“123”“456”的块，则这些选择的块都被替换成了名为“ABC”的块。
谢谢。

AyungerStudio

用ET-工具（Express-Tools）中就有该功能函数。

lengliqun

blockreplace　命令只能对块进行操作，不能将名为“123”“456”的块替换为CAD的搜索目录下名为“ABC.DWG”文件。

xyp1964

2. [FONT=courier new](defun c:test ()
   
3.   (command"insert""123=ABC" ^c)
   
4.   (command"insert""456=ABC" ^c)
   
5.   (princ)
   
6. )[/FONT]

[FONT=courier new](defun c:test ()<br />   (command"insert""123=ABC" ^c)<br />   (command"insert""456=ABC" ^c)<br />   (princ)<br /> )[/FONT]

xiaoliu626

不是很清楚．希望详细一些

qiaqiadeng

(defun dyq-get-oldstatus (/ oldstatus) ;存储系统原状态
  (setq oldstatus (list "oldstatus"))
  (setq oldstatus (cons "CLAYER" oldstatus))
  (setq oldstatus (cons (getvar "CLAYER") oldstatus))
  (setq oldstatus (cons "OSMODE" oldstatus))
  (setq oldstatus (cons (getvar "OSMODE") oldstatus))
  (setq oldstatus (cons "ORTHOMODE" oldstatus))
  (setq oldstatus (cons (getvar "ORTHOMODE") oldstatus))
  (setq oldstatus (cons "TEXTSTYLE" oldstatus))
  (setq oldstatus (cons (getvar "TEXTSTYLE") oldstatus))
  (setq oldstatus (cons "TEXTSIZE" oldstatus))
  (setq oldstatus (cons (getvar "TEXTSIZE") oldstatus))
  (setq oldstatus (cons (getvar "PICKSTYLE") oldstatus))
;当前标注样式要修改
  (setq oldstatus (reverse oldstatus))
)

(defun *$dyq-error$* (msg)
  ;(command ".undo" "")
  (setq *error* &olderr&)
  ;(princ)
)

(defun dyq-put-oldstatus (oldstatus) ;还原系统原系统变量
  (setq num (length oldstatus))
  (setq i 1)
  (repeat (/ (- num 1) 2)
    (setvar (nth i oldstatus) (nth (+ i 1) oldstatus))
    (setq i (+ i 2))
  )
)



(defun c:ta ()
  (princ "\n旧块换新颜")
  (setq &olderr& *error*)
  (setq *error* *$dyq-error$*)
  (setq oldstatus (dyq-get-oldstatus)) ;存储系统变量
  (setvar "OSMODE" 0)
  (setq i 0)
  (prompt "\n请选择原块:")
  (setq xz (ssget))
  (if (setq obj (entsel "\n请选择要替换成哪种块:"))
    (setq blockname (cdr (assoc '2 (entget (car obj)))))
    (setq blockname (getstring "\n请输入新块名:"))
  )
  (if (/= blockname "")
    (repeat (sslength xz)
      (setq obj (ssname xz i))
      (setq objlist (entget obj))
      (setq oldobjname (cdr (assoc '2 objlist)))
      (if (= (cdr (assoc '0 objlist)) "INSERT")
        (progn
          (setq objinsertpoint (cdr (assoc '10 (entget obj))))
          (if (tblsearch "block" blockname)
            (progn
              (entdel obj)
              (command "insert" blockname objinsertpoint 1 1 0)
            )
            (progn
              (if (= blockname "")
                (progn
                  (entdel obj)
                  (command "insert" oldobjname objinsertpoint 1 1 0)
                )
                (prompt "\n块不存在!")
              )
            )
          )
        )
        (prompt "\n所选择的不是块，重来!")
      )
      (setq i (+ i 1))
    )
    (princ "\n块名不能为空!")
  )
  (dyq-put-oldstatus oldstatus)
  (setq *error* &olderr&)
  (princ)
)

9701519

楼上的能不能改进一下！被替换的块的XYZ比例都变成1了！很麻烦！