[编程申请]：诚求直线变曲线的lisp

逐月飞鸿

平时在作设计的时候，很多时候需要把好多平行的直线（这些直线的中点在共线）改为圆曲线，每次都是一根一根的改，有没有这样的lisp，提示点选圆心后，能一下把他们改为共心的弧线呢？先谢高手的帮助了！

zxq0220

给个图看看，不然不知怎么编呀。

eachy

是这个意思吗？

2. 
   
3. (defun c:tt (/ ss pt ssl ms cen e sp ep r sa ea tf)
   
4.   (if (and (setq ss (ssget '((0 . "line"))))
   
5.            (setq pt (getpoint "\nCenter Point: "))
   
6.       )
   
7.     (progn
   
8.       (setq ssl        (sslength ss)
   
9.             ms        (vlax-get-property
   
10.                   (vlax-get-property (vlax-get-acad-object) 'activedocument)
    
11.                   'modelspace
    
12.                 )
    
13.             cen        (vlax-3d-point pt)
    
14.       )
    
15.       (while (> ssl 0)
    
16.         (setq e         (ssname ss (setq ssl (1- ssl)))
    
17.               sp (vlax-curve-getstartpoint e)
    
18.               ep (vlax-curve-getendpoint e)
    
19.               r         (distance pt (vlax-curve-getclosestpointto e pt))
    
20.               sa (angle pt sp)
    
21.               ea (angle pt ep)
    
22.         )
    
23.         (vla-addarc
    
24.           ms
    
25.           cen
    
26.           r
    
27.           (if (setq tf (> sa ea))
    
28.             ea
    
29.             sa
    
30.           )
    
31.           (if tf
    
32.             sa
    
33.             ea
    
34.           )
    
35.         )
    
36.       )
    
37.       (vl-cmdf ".erase" ss "")
    
38.     )
    
39.   )
    
40.   (princ)
    
41. )
    

<br /> (defun c:tt (/ ss pt ssl ms cen e sp ep r sa ea tf)<br />   (if (and (setq ss (ssget '((0 . "line"))))<br />            (setq pt (getpoint "\nCenter Point: "))<br />       )<br />     (progn<br />       (setq ssl        (sslength ss)<br />             ms        (vlax-get-property<br />                   (vlax-get-property (vlax-get-acad-object) 'activedocument)<br />                   'modelspace<br />                 )<br />             cen        (vlax-3d-point pt)<br />       )<br />       (while (> ssl 0)<br />         (setq e         (ssname ss (setq ssl (1- ssl)))<br />               sp (vlax-curve-getstartpoint e)<br />               ep (vlax-curve-getendpoint e)<br />               r         (distance pt (vlax-curve-getclosestpointto e pt))<br />               sa (angle pt sp)<br />               ea (angle pt ep)<br />         )<br />         (vla-addarc<br />           ms<br />           cen<br />           r<br />           (if (setq tf (> sa ea))<br />             ea<br />             sa<br />           )<br />           (if tf<br />             sa<br />             ea<br />           )<br />         )<br />       )<br />       (vl-cmdf ".erase" ss "")<br />     )<br />   )<br />   (princ)<br /> )<br />

小妹丁

05中不能执行，06正常

小妹丁

T

雪山飞狐(lzh)

前面加
(vl-load-com)

逐月飞鸿

谢谢你们的热心帮助，但是改过后线型发生了变化，都变成直线了，如果改后的线型能和原来对应一致就完美了……

hwg7511039

哦
我也学到了!
大家辛苦了!