演示遍历多段线顶点，给所有弧线段加粗的代码

newer

                               
登录/注册后可看大图

1. (defun c:XDTB_PlineArcSegWidth (/ e sw ew p i pts area v)
   
2.   (xd::begin)
   
3.   (if (and
   
4.         (setq e (xdrx_entsel "\n选择pline: " '((0 . "LWPOLYLINE"))))
   
5.         (progn
   
6.           (sssetfirst nil (xd::entity->pickset (list (car e))))
   
7.           t
   
8.         )
   
9.         (setq sw (getdist (cadr e) "\n起始宽度:　"))
   
10.         (if (setq ew (getdist (cadr e) (strcat "\n终止宽度<" (rtos sw 2 2) ">: ")))
    
11.           ew
    
12.           (setq ew sw)
    
13.         )
    
14.       )
    
15.     (progn
    
16.       (setq vnum (xdrx_polyline_numverts (setq e (car e))))
    
17.       (setq i 0)
    
18.       (repeat vnum
    
19.         (if (= "kArc" (xdrx_polyline_segtype e i))
    
20.            (xdrx_setpropertyvalue e "WidthAt" (list i sw ew))
    
21.         )
    
22.         (setq i (1+ i))
    
23.       )
    
24.     )
    
25.   )
    
26.   (xd::end)
    
27.   (princ)
    
28. )

(defun c:XDTB_PlineArcSegWidth (/ e sw ew p i pts area v)<br />   (xd::begin)<br />   (if (and<br />         (setq e (xdrx_entsel "\n选择pline: " '((0 . "LWPOLYLINE"))))<br />         (progn<br />           (sssetfirst nil (xd::entity->pickset (list (car e))))<br />           t<br />         )<br />         (setq sw (getdist (cadr e) "\n起始宽度:　"))<br />         (if (setq ew (getdist (cadr e) (strcat "\n终止宽度<" (rtos sw 2 2) ">: ")))<br />           ew<br />           (setq ew sw)<br />         )<br />       )<br />     (progn<br />       (setq vnum (xdrx_polyline_numverts (setq e (car e))))<br />       (setq i 0)<br />       (repeat vnum<br />         (if (= "kArc" (xdrx_polyline_segtype e i))<br />            (xdrx_setpropertyvalue e "WidthAt" (list i sw ew))<br />         )<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   (xd::end)<br />   (princ)<br /> )

清风明月10

谢谢楼主的分享！太好用了！收藏备用。

zhong2013

楼主测试一下，这个DWG，是不是有些弧线段不能加粗