删除块内指定图元

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. ;;;转角标注.AcDbRotatedDimension
    
19. ;;;对齐标注.AcDbAlignedDimension
    
20. 
    
21. ;;;获取图元ObjectName：(Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'ObjectName)
    
22. (defun del-ent-in-blk(ent objname / blk_name blkobj lst)
    
23.   (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))
    
24.     (if (and
    
25.           (= objname "AcDbAttribute")
    
26.           (setq lst (vlax-safearray->list
    
27.                       (vlax-variant-value
    
28.                         (vla-GetAttributes (vlax-ename->vla-object ent))
    
29.                       )
    
30.                     )
    
31.           )
    
32.         )
    
33.       (foreach x lst (vla-Delete x));删除块内所有定义属性
    
34.       (progn
    
35.         (setq blk_name (cdr (assoc 2 (entget ent))))
    
36.         (vlax-for item (setq blkobj (vlax-invoke-method (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) 'Item blk_name))
    
37.           (if (= (vla-get-ObjectName item) objname) (vla-Delete item))
    
38.         )
    
39.         (entupd ent)
    
40.       );删除块内除定义属性外指定图元名的图元
    
41.     )
    
42.     (princ "图元不是块或没有选择图块！")
    
43.   )
    
44.   (prin1)
    
45. )
    

;;忘霄(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 /> ;;;转角标注.AcDbRotatedDimension<br /> ;;;对齐标注.AcDbAlignedDimension<br /> <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 />

革天明

谢谢楼主分享

走走逛逛瞧瞧

可以删除参照里的吗

fangmin723

走走逛逛瞧瞧 发表于 2018-11-8 01:52
可以删除参照里的吗

没有研究过，不过你可以试试

KO你

可以多选吗

fangmin723

KO你 发表于 2021-11-24 19:53
可以多选吗

稍作修改就可以

alexmai

希望能添加上，删除块内 所有尺寸 的功能 AcDbRotatedDimension

fangmin723

alexmai 发表于 2021-12-2 21:12
希望能添加上，删除块内 所有尺寸 的功能 AcDbRotatedDimension

谢谢建议，已添加转角标注和对齐标注

tdl555

我还看不到版主的帖子，发帖数不够，要加油啊

yk1216

谢谢分享，很实用