求多义线直线段变弧线段代码

清风明月10

我想求高手写一个插件，将轻多义线、二维多义线、三维多义线（只对轻多义线有效亦可）的鼠标指定的某直线段改为弧线段，这样多义线就可以和样条曲线一样可以圆滑过渡了。
它的反插件，即将多义线弧线段变直线段请朋友顺手也写一个。

csharp

清风明月10 发表于 2014-7-6 08:00
谢谢提醒！但我的专业软件限定在低版本，高版本不能用

点弧线段直接变直线，点直线段拉伸为弧线（模拟高版本的变弧线段）
没有加错误处理，中断后命令行输入 (xdrx_pointmonitor) 中断点监视

1. (defun c:tt (/ e ent p pam seg tf bp sp ep pmid an1 _pi2 p3 )
   
2.   (defun CallBack (dynpt / d mpind1 p4 pcen van)
   
3.     (setq d (xdrx_point_dist2line dynpt sp ep))
   
4.     (cond
   
5.       ((minusp d)
   
6.        (setq pmid1 (xdrx_line_midp sp dynpt)
   
7.              p4           (polar pmid1 (+ (angle sp dynpt) _pi2) 1.)
   
8.              pcen  (inters pmid p3 pmid1 p4 nil)
   
9.              van   (xdrx_vector_angle (mapcar '- sp pcen) (mapcar '- ep pcen))
   
10.        )
    
11.        (xdrx_polyline_setbulgeat
    
12.          ent
    
13.          seg
    
14.          (- (xdrx_math_tan (/ van 4.)))
    
15.        )
    
16.       )
    
17.       ((> d 0.)
    
18.        (setq pmid1 (xdrx_line_midp sp dynpt)
    
19.              p4           (polar pmid1 (+ (angle sp dynpt) _pi2) 1.)
    
20.              pcen  (inters pmid p3 pmid1 p4 nil)
    
21.              van   (xdrx_vector_angle (mapcar '- sp pcen) (mapcar '- ep pcen))
    
22.        )
    
23.        (xdrx_polyline_setbulgeat
    
24.          ent
    
25.          seg
    
26.          (xdrx_math_tan (/ van 4.))
    
27.        )
    
28.       )
    
29.       ((zerop d)
    
30.        (xdrx_polyline_setbulgeat ent seg 0.)
    
31.       )
    
32.       (t)
    
33.     )
    
34.   )
    
35.   (if (setq e (xdrx_entsel "\nPick Polyline: " '((0 . "*Polyline"))))
    
36.     (progn
    
37.       (setq ent        (car e)
    
38.             p        (apply 'vlax-curve-getclosestpointto e)
    
39.             pam        (vlax-curve-getparamatpoint ent p)
    
40.             seg        (fix pam)
    
41.             tf        (xdrx_polyline_segtype ent seg)
    
42.       )
    
43.       (if (= tf "kArc")
    
44.         (xdrx_polyline_setbulgeat ent seg 0.)
    
45.         (progn
    
46.           (setq        bp   (vlax-curve-getpointatparam ent (+ seg 0.5))
    
47.                 _pi2 (* pi 0.5)
    
48.           )
    
49.           (mapcar 'set '(sp ep) (xdrx_polyline_getlinesegat ent seg))
    
50.           (setq        an1  (angle sp ep)
    
51.                 pmid (xdrx_line_midp sp ep)
    
52.                 p3   (polar pmid (+ an1 _pi2) 1.)
    
53.           )
    
54.           (xdrx_pointmonitor "CallBack" ent)
    
55.           (getpoint bp)
    
56.           (xdrx_pointmonitor)
    
57.         )
    
58.       )
    
59.     )
    
60.   )
    
61.   (princ)
    
62. )
    

(defun c:tt (/ e ent p pam seg tf bp sp ep pmid an1 _pi2 p3 )<br />   (defun CallBack (dynpt / d mpind1 p4 pcen van)<br />     (setq d (xdrx_point_dist2line dynpt sp ep))<br />     (cond<br />       ((minusp d)<br />        (setq pmid1 (xdrx_line_midp sp dynpt)<br />              p4           (polar pmid1 (+ (angle sp dynpt) _pi2) 1.)<br />              pcen  (inters pmid p3 pmid1 p4 nil)<br />              van   (xdrx_vector_angle (mapcar '- sp pcen) (mapcar '- ep pcen))<br />        )<br />        (xdrx_polyline_setbulgeat<br />          ent<br />          seg<br />          (- (xdrx_math_tan (/ van 4.)))<br />        )<br />       )<br />       ((> d 0.)<br />        (setq pmid1 (xdrx_line_midp sp dynpt)<br />              p4           (polar pmid1 (+ (angle sp dynpt) _pi2) 1.)<br />              pcen  (inters pmid p3 pmid1 p4 nil)<br />              van   (xdrx_vector_angle (mapcar '- sp pcen) (mapcar '- ep pcen))<br />        )<br />        (xdrx_polyline_setbulgeat<br />          ent<br />          seg<br />          (xdrx_math_tan (/ van 4.))<br />        )<br />       )<br />       ((zerop d)<br />        (xdrx_polyline_setbulgeat ent seg 0.)<br />       )<br />       (t)<br />     )<br />   )<br />   (if (setq e (xdrx_entsel "\nPick Polyline: " '((0 . "*Polyline"))))<br />     (progn<br />       (setq ent        (car e)<br />             p        (apply 'vlax-curve-getclosestpointto e)<br />             pam        (vlax-curve-getparamatpoint ent p)<br />             seg        (fix pam)<br />             tf        (xdrx_polyline_segtype ent seg)<br />       )<br />       (if (= tf "kArc")<br />         (xdrx_polyline_setbulgeat ent seg 0.)<br />         (progn<br />           (setq        bp   (vlax-curve-getpointatparam ent (+ seg 0.5))<br />                 _pi2 (* pi 0.5)<br />           )<br />           (mapcar 'set '(sp ep) (xdrx_polyline_getlinesegat ent seg))<br />           (setq        an1  (angle sp ep)<br />                 pmid (xdrx_line_midp sp ep)<br />                 p3   (polar pmid (+ an1 _pi2) 1.)<br />           )<br />           (xdrx_pointmonitor "CallBack" ent)<br />           (getpoint bp)<br />           (xdrx_pointmonitor)<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

csharp

高版本已经内置此功能，右键菜单中

清风明月10

谢谢提醒！但我的专业软件限定在低版本，高版本不能用

清风明月10

csharp 发表于 2014-7-6 11:04
点弧线段直接变直线，点直线段拉伸为弧线（模拟高版本的变弧线段）
没有加错误处理，中断后命令行输入 ( ...

试好了，是我搞错了，对直线动作，才没有效果。

csharp

清风明月10 发表于 2014-7-6 11:20
试了好久，一点效果都没有。你是针对哪种多段线有效啊？最好是对各类多段线都有效，否则我没法用。
也不 ...

没有用到 xd-lisp-lib.vlx 函数，只需要 API，加上 (xd::begin) 和 (xd::end) 中断后自动取消 pointmonitor 了