[求助]那位大侠有块替换功能的程序

kyz2007 · 发表于 2008-6-12 23:34

最好是有择性指定两个块名之间替换,只框一次就能将图档内一个块替成另一个块.

bendan250 · 发表于 2008-6-16 09:24

用学院派工具箱可以实现。

dinosaurhxe · 发表于 2008-6-16 14:13

半年前经MJTD高人指点的程序，希望对你有点用。当时没能记录下是哪位高人指点的，在此致歉。

;本程序经MJTD高人指点，非自己独立编写，转载请保留本行！！------dinosaurhxe@MJTD
;换块，2007.12.5
(defun c:hk (/ oom km1 km2 xzgl ss bn name)
(setq oom (getvar "osmode"))
(setvar "osmode" 0)
(defun dkm (/ pit)
(setq pit nil)
(while (/= (type pit) 'STR)
(initget 128)
(setq pit (getpoint "输入块名或选择实体读取块名:"))
(cond
((and (= 'LIST (type pit)) (setq ss (ssget pit)))
(setq pit (get 2 (entget (ssname ss 0))))
)
((= (type pit) 'STR) nil)
)
)
pit
)
(prompt "\n请输入源块块名，")
(setq km2 (strcase (dkm)))
(prompt "\n请输入目标块的块名，")
(setq km1 (strcase (dkm)))
(setq xzgl (list '(0 . "INSERT") (cons 2 km1)))
(while (setq ss (ssget xzgl))
(mapcar '(lambda (x / bn)
(setq x (vlax-ename->vla-object x)
bn (strcase (vlax-get-property x 'name))
)
(vlax-put-property x 'name km2)
)
(lt:ss->list ss)
)
)
(setvar "osmode" oom)
)
(defun lt:ss->list (ss / en)
(vl-remove nil
(mapcar '(lambda (x)
(if (= (type (setq en (cadr x))) 'ename)
en
)
)
(ssnamex ss)
)
)
)

;本程序经MJTD高人指点，非自己独立编写，转载请保留本行！！------dinosaurhxe@MJTD
;换块，2007.12.5
(defun c:hk (/ oom km1 km2 xzgl ss bn name)
  (setq oom (getvar "osmode"))
  (setvar "osmode" 0)
  (defun dkm (/ pit)
    (setq pit nil)
    (while (/= (type pit) 'STR)
      (initget 128)
      (setq pit (getpoint "输入块名或选择实体读取块名:"))
      (cond
 ((and (= 'LIST (type pit)) (setq ss (ssget pit)))
  (setq pit (get 2 (entget (ssname ss 0))))
 )
 ((= (type pit) 'STR) nil)
      )
    )
    pit
  )
  (prompt "\n请输入源块块名，")
  (setq km2 (strcase (dkm)))
  (prompt "\n请输入目标块的块名，")
  (setq km1 (strcase (dkm)))
  (setq xzgl (list '(0 . "INSERT") (cons 2 km1)))
  (while (setq ss (ssget xzgl))
    (mapcar '(lambda (x / bn)
        (setq x (vlax-ename->vla-object x)
       bn (strcase (vlax-get-property x 'name))
        )
        (vlax-put-property x 'name km2)
      )
     (lt:ss->list ss)
    )
  )
  (setvar "osmode" oom)
)
(defun lt:ss->list (ss / en)
  (vl-remove nil
      (mapcar '(lambda (x)
   (if (= (type (setq en (cadr x))) 'ename)
     en
   )
        )
       (ssnamex ss)
      )
  )
)

kyz2007 · 发表于 2008-6-17 21:03

先谢谢你的无私奉献

fengsea · 发表于 2008-6-17 23:45

块是换了，但步骤比较麻烦，特别是匿名块，比较有用的lsp，希望那位高手修改一下，要是先能选择源块，不需要输入块名默认支持实体选择（支持框选）然后选择目标块便能更改就好了（支持框选），恳请高手们修改！！！！！！！！！

英雄无敌 · 发表于 2008-6-18 09:16

试试我这个，但请恕不提供源码。

kyz2007 · 发表于 2008-6-19 19:59

6楼的试过了比3楼的好多了但是替换时没有选择性,本想两个块之替换,框选图档内的不同名块都被替换了.框选时能否只替换指定一个块而其它块不被替掉.期望更多高手出现.

英雄无敌 · 发表于 2008-6-19 21:55

这你就得把要求写清楚了，两个块，怎么替换。最好把步骤写一下。

kyz2007 · 发表于 2008-6-20 19:46

一幅零件图内有不同名块A,B,C,D,E........框选时只想A替换B而其它C,D,E等块即使被框选到都不会被替掉,请问英雄无敌大侠能否实现这功能呢.

dinosaurhxe · 发表于 2008-6-20 19:57

个人觉得３楼的程序也支持选取读块名而不是非得输入块名啊？

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

[求助]那位大侠有块替换功能的程序

本帖子中包含更多资源