删除块内指定图元

fangmin723

1. ;;忘霄(702099480)-2018.9.28
   
2. ;;说明:删除块内指定图元
   
3. ;;参数:ent:块的图元名
   
4. ;;参数:ObjectName:图元objectname;
   
5. ;(del-ent-in-blk ent "AcDbAttribute")
   
6. ;;常用的有：
   
7. ;;;直线.AcDbLine
   
8. ;;;构造线.AcDbXline
   
9. ;;;多段线(多边形/矩形).AcDbPolyline
   
10. ;;;圆.AcDbCircle
    
11. ;;;圆弧.AcDbArc
    
12. ;;;样条曲线.AcDbSpline
    
13. ;;;椭圆(弧).AcDbEllipse
    
14. ;;;点.AcDbPoint
    
15. ;;;文字.AcDbText
    
16. ;;;多行文字.AcDbMText
    
17. ;;;块属性.AcDbAttribute
    
18. ;;;获取图元ObjectName：(Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'ObjectName)
    
19. (defun del-ent-in-blk(ent objname / blk_name blkobj lst)
    
20.   (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))
    
21.     (if (and
    
22.           (= objname "AcDbAttribute")
    
23.           (setq lst (vlax-safearray->list
    
24.                       (vlax-variant-value
    
25.                         (vla-GetAttributes (vlax-ename->vla-object ent))
    
26.                       )
    
27.                     )
    
28.           )
    
29.         )
    
30.       (foreach x lst (vla-Delete x));删除块内所有定义属性
    
31.       (progn
    
32.         (setq blk_name (cdr (assoc 2 (entget ent))))
    
33.         (vlax-for item (setq blkobj (vlax-invoke-method (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) 'Item blk_name))
    
34.           (if (= (vla-get-ObjectName item) objname) (vla-Delete item))
    
35.         )
    
36.         (entupd ent)
    
37.       );删除块内除定义属性外指定图元名的图元
    
38.     )
    
39.     (princ "图元不是块或没有选择图块！")
    
40.   )
    
41.   (prin1)
    
42. )
    

;;忘霄(702099480)-2018.9.28<br /> ;;说明:删除块内指定图元<br /> ;;参数:ent:块的图元名<br /> ;;参数:ObjectName:图元objectname;<br /> ;(del-ent-in-blk ent "AcDbAttribute")<br /> ;;常用的有：<br /> ;;;直线.AcDbLine<br /> ;;;构造线.AcDbXline<br /> ;;;多段线(多边形/矩形).AcDbPolyline<br /> ;;;圆.AcDbCircle<br /> ;;;圆弧.AcDbArc<br /> ;;;样条曲线.AcDbSpline<br /> ;;;椭圆(弧).AcDbEllipse<br /> ;;;点.AcDbPoint<br /> ;;;文字.AcDbText<br /> ;;;多行文字.AcDbMText<br /> ;;;块属性.AcDbAttribute<br /> ;;;获取图元ObjectName：(Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'ObjectName)<br /> (defun del-ent-in-blk(ent objname / blk_name blkobj lst)<br />   (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))<br />     (if (and<br />           (= objname "AcDbAttribute")<br />           (setq lst (vlax-safearray->list<br />                       (vlax-variant-value<br />                         (vla-GetAttributes (vlax-ename->vla-object ent))<br />                       )<br />                     )<br />           )<br />         )<br />       (foreach x lst (vla-Delete x));删除块内所有定义属性<br />       (progn<br />         (setq blk_name (cdr (assoc 2 (entget ent))))<br />         (vlax-for item (setq blkobj (vlax-invoke-method (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) 'Item blk_name))<br />           (if (= (vla-get-ObjectName item) objname) (vla-Delete item))<br />         )<br />         (entupd ent)<br />       );删除块内除定义属性外指定图元名的图元<br />     )<br />     (princ "图元不是块或没有选择图块！")<br />   )<br />   (prin1)<br /> )<br />

czm980251042

有时候大的图里面，切换进块里面编辑确实挺麻烦的

fangmin723

czm980251042 发表于 2018-9-29 09:30
有时候大的图里面，切换进块里面编辑确实挺麻烦的

再送一礼

(setq str (cdr (assoc 1 (entget (car (nentselp pt))))))拾取块内属性文字

czm980251042

有时候大的图里面，切换进块里面编辑确实挺麻烦的

ming1789

感謝分享              

sicky111

谢谢分享！

luohonghe

fangmin723 发表于 2018-9-29 09:35
再送一礼

(setq str (cdr (assoc 1 (entget (car (nentselp pt))))))拾取块内属性文字

快捷键是什么？

luohonghe

可以设置一下快捷键吗？

fangmin723

luohonghe 发表于 2021-1-18 10:35
可以设置一下快捷键吗？

你自己可以设置一下

xvjiex

删除块内指定图元 ，感谢分享！