[下载]：自己用的块替换程序

carrot1983

注明：主通用程序，是改网上下载的程序的。当然自己也可以写。
[php]
;;;***************************************************btt同名多块替换
(defun c:btt()
  (setq blkname1 (getstring "\n被替换的块名称:"))
  (if (= blkname1 "") (exit))       
  (setq blkname2 (getstring (strcat "\n替换成后块名称<" blkname1 ">:")))
  (if (= blkname2 "") (setq blkname2 blkname1))       
  (blkrepl blkname1 blkname2)
  (princ)
)


;;;次通用程序
;;;get_blk_pt获取同名多个块的定义点组成的表
(defun get_blk_pt(blkname code / ss sslen i na data ptlist)
  (setq ss (ssget "x" (list (cons 0 "INSERT") (cons 2 blkname))))
  (setq sslen (1- (sslength ss)))
  (setq i 0)
  (while (<= i sslen)
  (setq na (ssname ss i))
  (setq data (entget na))
  (foreach n data
    (if (= code (car n))
      (setq ptlist (cons (cdr n) ptlist))
    )
  )
  (setq i (1+ i))
  )
  (reverse ptlist)
)

;;;主通用程序
(defun blkrepl (blkname1 blkname2 / blkptlist k len donecount blkpt)
  (setq osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (command "_.undo" "_begin")
  (if (ssget "x" (list (cons 0 "INSERT") (cons 2 blkname1)))  
         (progn  
               (setq blkptlist (get_blk_pt blkname1 10))
               (setq blkanglist (get_blk_pt blkname1 50))
               (setq len (1- (length blkptlist)))
               (command "erase" "P" "")
   
  (if (tblsearch "block" blkname1)(command "purge" "b" blkname1 "n"))
  (setq k 0)
  (setvar "CLAYER" "0")
  (while (<= k len)
    (setq blkpt (nth k blkptlist))
    (setq blkang (angtos (nth k blkanglist) 0 0))
    (command "insert" blkname2 blkpt "1" "1" blkang)
    (setq k (1+ k))
  )
  (princ (strcat "\n完成 "
                 (itoa k)
                 " 个名称为"
                 blkname1
                 "替换"
                 blkname2
                 "的块."
         ))
   )) ;;;end progn&if
  (setvar "osmode" osm)
  (command "_.undo" "_end")
  (prin1)
)
[/php]

coco25825

感觉不好用，(setq blkname1 (getstring "\n被替换的块名称:")) 图块名字不好记，如果是点取原块，执行(setq blkname2 (getstring (strcat "\n替换成后块名称<" blkname1 ">:")))

kaiwen1000

好东西，谢谢哦！