移除多段线的bulge

Lisphk

1. (defun c:RemoveBulge ( / ActDoc Sel Data Ent Param Obj )
   
2.    
   
3.     (vl-load-com)
   
4.     (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
   
5.     (vla-EndUndoMark ActDoc)
   
6.     (vla-StartUndoMark ActDoc)
   
7.     (setvar 'ErrNo 0)
   
8.     (while (not (equal (getvar 'ErrNo) 52))
   
9.         (if
   
10.             (and
    
11.                 (setq Sel (entsel "\n Select polyline at bulge segment to remove: "))
    
12.                 (setq Data (entget (setq Ent (car Sel))))
    
13.                 (wcmatch (cdr (assoc 0 Data)) "*POLYLINE")
    
14.                 (setq Param
    
15.                     (vlax-curve-getParamAtPoint
    
16.                         Ent
    
17.                         (vlax-curve-getClosestPointTo Ent (trans (cadr Sel) 1 0))
    
18.                     )
    
19.                 )
    
20.                 (setq Obj (vlax-ename->vla-object Ent))
    
21.             )
    
22.             (vla-SetBulge Obj (fix Param) 0.)
    
23.             (if (not (equal (getvar 'ErrNo) 52))
    
24.                 (prompt "\n No polyline selected.")
    
25.             )
    
26.         )
    
27.     )
    
28.     (vla-EndUndoMark ActDoc)
    
29.     (princ)
    
30. )
    

(defun c:RemoveBulge ( / ActDoc Sel Data Ent Param Obj )<br />    <br />     (vl-load-com)<br />     (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))<br />     (vla-EndUndoMark ActDoc)<br />     (vla-StartUndoMark ActDoc)<br />     (setvar 'ErrNo 0)<br />     (while (not (equal (getvar 'ErrNo) 52))<br />         (if<br />             (and<br />                 (setq Sel (entsel "\n Select polyline at bulge segment to remove: "))<br />                 (setq Data (entget (setq Ent (car Sel))))<br />                 (wcmatch (cdr (assoc 0 Data)) "*POLYLINE")<br />                 (setq Param<br />                     (vlax-curve-getParamAtPoint<br />                         Ent<br />                         (vlax-curve-getClosestPointTo Ent (trans (cadr Sel) 1 0))<br />                     )<br />                 )<br />                 (setq Obj (vlax-ename->vla-object Ent))<br />             )<br />             (vla-SetBulge Obj (fix Param) 0.)<br />             (if (not (equal (getvar 'ErrNo) 52))<br />                 (prompt "\n No polyline selected.")<br />             )<br />         )<br />     )<br />     (vla-EndUndoMark ActDoc)<br />     (princ)<br /> )<br />

hh_lj007

楼主威武，学习了