本程序可以直接删除图块中的图元对象(比REFEDIT快捷)

四方志成

2. ;;;***************************************************************************************************************/*****************************
   
3. ;;;[功能]：本程序可以直接删除图块中的图元对象(比REFEDIT快捷)                                                      启动命令：DBE                 
   
4. ;;;***************************************************************************************************************/*****************************
   
5. (defun C:DBE (/ *ERROR* E)
   
6.   (defun *error* (msg)
   
7.     (if        (or (= msg "function cancelled") (= msg "quit/exit abort"))
   
8.       (princ)
   
9.       (progn
   
10.         (princ msg)
    
11.         (setq *error* nil)
    
12.         ;结束Undo命令编组
    
13.         (command "_.undo" "_E")
    
14.       )
    
15.     )
    
16.   )
    
17.     ;;;关闭command 函数运行时 AutoCAD 回显提示和输入
    
18.   (setvar "cmdecho" 0)
    
19.   ;结束Undo命令编组
    
20.   (command "_.undo" "_BE")
    
21.   (write-line "\n<<本程序可以直接删除图块中的图元对象(比REFEDIT快捷)(命令：DBE)>>  开发者：张占锋")
    
22.   (while (setq ent (nentsel "\选择要删除的图元你对象:"))
    
23.     (vla-delete (vlax-ename->vla-object (car ent)))
    
24.     (if (= (length ent) 4)
    
25.       (mapcar 'entupd (last ent))
    
26.     )
    
27.   )
    
28.   ;结束Undo命令编组
    
29.   (command "_.undo" "_E")
    
30. )

;;;***************************************************************************************************************/*****************************<br /> ;;;[功能]：本程序可以直接删除图块中的图元对象(比REFEDIT快捷)                                                      启动命令：DBE                 <br /> ;;;***************************************************************************************************************/*****************************<br /> (defun C:DBE (/ *ERROR* E)<br />   (defun *error* (msg)<br />     (if        (or (= msg "function cancelled") (= msg "quit/exit abort"))<br />       (princ)<br />       (progn<br />         (princ msg)<br />         (setq *error* nil)<br />         ;结束Undo命令编组<br />         (command "_.undo" "_E")<br />       )<br />     )<br />   )<br />     ;;;关闭command 函数运行时 AutoCAD 回显提示和输入<br />   (setvar "cmdecho" 0)<br />   ;结束Undo命令编组<br />   (command "_.undo" "_BE")<br />   (write-line "\n<<本程序可以直接删除图块中的图元对象(比REFEDIT快捷)(命令：DBE)>>  开发者：张占锋")<br />   (while (setq ent (nentsel "\选择要删除的图元你对象:"))<br />     (vla-delete (vlax-ename->vla-object (car ent)))<br />     (if (= (length ent) 4)<br />       (mapcar 'entupd (last ent))<br />     )<br />   )<br />   ;结束Undo命令编组<br />   (command "_.undo" "_E")<br /> )

ScmTools

支持分享!

清风明月10

谢谢楼主的分享，非常好用，收藏备用了！

Lisphk

谢谢楼主分享，有个地方没看懂
    (if (= (length ent) 4)
      (mapcar 'entupd (last ent))
    )
为什么要加个这个判断，直接entupd不行吗？

炫翔

Lisphk 发表于 2013-5-19 17:22
谢谢楼主分享，有个地方没看懂
    (if (= (length ent) 4)
      (mapcar 'entupd (last ent))

mapcar  是将表中每一个项都进行entupd

Lisphk

炫翔 发表于 2013-5-19 18:19
mapcar  是将表中每一个项都进行entupd

测试个块

2. 
   
3. 命令: (setq e  (nentsel))
   
4. 
   
5. 选择对象: (<图元名: 7ef98428> (2532.82 593.646 0.0) ((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0
   
6. 0.0 1.0) (2286.18 932.577 0.0)) (<图元名: 7ef98438>))
   
7. 
   
8. 命令: (length e)
   
9. 4
   
10. 
    
11. 命令: (last e)
    
12. (<图元名: 7ef98438>)
    

<br /> 命令: (setq e  (nentsel))<br /> <br /> 选择对象: (<图元名: 7ef98428> (2532.82 593.646 0.0) ((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 <br /> 0.0 1.0) (2286.18 932.577 0.0)) (<图元名: 7ef98438>))<br /> <br /> 命令: (length e)<br /> 4<br /> <br /> 命令: (last e)<br /> (<图元名: 7ef98438>)<br />

斑竹，程序里面的ENT 长度有不是4的时候吗？  另外，(last ent) 什么时候长度不是1，而需要MAPCAR 去处理？

炫翔

Lisphk 发表于 2013-5-19 18:57
测试个块斑竹，程序里面的ENT 长度有不是4的时候吗？  另外，(last ent) 什么时候长度不是1，而需要MAPCA ...

上面我只是说明  mapcar 的用法，
这个直接entupd  是可以的

Lisphk

炫翔 发表于 2013-5-19 19:11
上面我只是说明  mapcar 的用法，
这个直接entupd  是可以的

看到楼主的程序那样写，感觉是不是有什么我还不知道的东西。

炫翔

Lisphk 发表于 2013-5-19 19:38
看到楼主的程序那样写，感觉是不是有什么我还不知道的东西。

一个程序有N种写法的，有的直路，有的转弯了

lewyee

处理特定对象各有优势吧

杨水每峰

有价值啊好东西

米克

复制了函数  变成LSP  可是不能用啊？？？？？？？？？

米克

怎么说是未知命令啊？

炫翔

添加有没有想过？

dbx5511

还行，有点小建议，似乎有些问题，如果要删除块内的嵌套块，就没法把块内嵌套块给这个一次删除，只能删除嵌套块内的一个图元，导致意想不到的情况出现，另外最还能框选。现在只能一次点一个单位图元。