[LISP程序]：均分两条曲线

陌生人

干活累了，发个东西玩玩

2. 
   
3. ;直接画线的写法:  ----------------------------陌生人.2003.12
   
4. ;画线等分两条曲线
   
5. (defun c:rule2cur ()
   
6.   (vl-load-com)
   
7.   (setq
   
8.       e1 (vlax-ename->vla-object (car(entsel "\n第一条曲线:")))
   
9.       e2 (vlax-ename->vla-object (car(entsel "\n第二条曲线:")))
   
10.       n  (getint "\n等分数:")
    
11.       d1 (/ (vlax-curve-getDistAtparam e1 (vlax-curve-getendparam  e1)) n)
    
12.       d2 (/ (vlax-curve-getDistAtparam e2 (vlax-curve-getendparam  e2)) n))
    
13.   (while (not (minusp n))
    
14.          (vl-cmdf ".line" (vlax-curve-getPointAtDist e1 (* d1 n))
    
15.                           (vlax-curve-getPointAtDist e2 (* d2 n)) "")
    
16.          (setq n (- n 1))
    
17.   )
    
18.   (princ)
    
19. )
    

<br /> ;直接画线的写法:  ----------------------------陌生人.2003.12<br /> ;画线等分两条曲线<br /> (defun c:rule2cur ()<br />   (vl-load-com)<br />   (setq <br />       e1 (vlax-ename->vla-object (car(entsel "\n第一条曲线:")))<br />       e2 (vlax-ename->vla-object (car(entsel "\n第二条曲线:")))<br />       n  (getint "\n等分数:")<br />       d1 (/ (vlax-curve-getDistAtparam e1 (vlax-curve-getendparam  e1)) n)<br />       d2 (/ (vlax-curve-getDistAtparam e2 (vlax-curve-getendparam  e2)) n))<br />   (while (not (minusp n))<br />          (vl-cmdf ".line" (vlax-curve-getPointAtDist e1 (* d1 n))<br />                           (vlax-curve-getPointAtDist e2 (* d2 n)) "")<br />          (setq n (- n 1))<br />   )<br />   (princ)<br /> )<br />

画线也可用vla方法

lsjjm

老兄，可能有点小BUG. 不均分，只画了两条端点的连接线？！

eachy

画线受 osmode 影响，均分和曲线方向有关。

tsh007

使用跟2楼的一样，还是交叉连线的，请“青铜长老”给完善一下。

梦断江南

主要是因为画线的时候打开了捕捉方式，只要执行前关调捕捉就正常了。或者用下面我试着修改的程序。

2. 
   
3. [FONT=arial]
   
4. ;直接画线的写法:  ----------------------------陌生人.2003.12
   
5. ;画线等分两条曲线
   
6. (defun c:rule2cur ()
   
7.   (vl-load-com)
   
8.   (setq
   
9.       msp(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
   
10.       e1 (vlax-ename->vla-object (car(entsel "\n第一条曲线:")))
    
11.       e2 (vlax-ename->vla-object (car(entsel "\n第二条曲线:")))
    
12.       n  (getint "\n等分数:")
    
13.       d1 (/ (vlax-curve-getDistAtparam e1 (vlax-curve-getendparam  e1)) n)
    
14.       d2 (/ (vlax-curve-getDistAtparam e2 (vlax-curve-getendparam  e2)) n))
    
15.   (while (not (minusp n))
    
16.          (vla-addline msp (vlax-3d-point (vlax-curve-getPointAtDist e1 (* d1 n)))
    
17.                           (vlax-3d-point (vlax-curve-getPointAtDist e2 (* d2 n))))
    
18.          (setq n (- n 1))
    
19.   )
    
20.   (princ)
    
21. )
    
22. [/font]

<br /> [FONT=arial]<br /> ;直接画线的写法:  ----------------------------陌生人.2003.12<br /> ;画线等分两条曲线<br /> (defun c:rule2cur ()<br />   (vl-load-com)<br />   (setq<br />       msp(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))<br />       e1 (vlax-ename->vla-object (car(entsel "\n第一条曲线:")))<br />       e2 (vlax-ename->vla-object (car(entsel "\n第二条曲线:")))<br />       n  (getint "\n等分数:")<br />       d1 (/ (vlax-curve-getDistAtparam e1 (vlax-curve-getendparam  e1)) n)<br />       d2 (/ (vlax-curve-getDistAtparam e2 (vlax-curve-getendparam  e2)) n))<br />   (while (not (minusp n))<br />          (vla-addline msp (vlax-3d-point (vlax-curve-getPointAtDist e1 (* d1 n)))<br />                           (vlax-3d-point (vlax-curve-getPointAtDist e2 (* d2 n))))<br />          (setq n (- n 1))<br />   )<br />   (princ)<br /> )<br /> [/font]

也可以通过设 (setq os (getvar "osmode"))(setvar "osmode" 0).......
(setvar "osmode" os)

eachy

最初由 梦断江南 发布
[B]主要是因为画线的时候打开了捕捉方式，只要执行前关调捕捉就正常了。或者用下面我试着修改的程序。
[code]

;直接画线的写法:  ----------------------------陌生人.2003.12
;画线等分两条曲线
(de... [/B]

你这个还是没有考虑两条线的方向不同情况。

aeo

方向应该在两次entsel上面做文章:就象"RULESURF"一样

陌生人

2. [font=arial]
   
3. ;rule2c = 画线等分两条曲线 v2 ----------------------------陌生人.2003.12
   
4. ;避开捕捉造成的错误画线.
   
5. ;支持无关曲线起点终点. 根据点中曲线的位置画线.! 2004.1.7
   
6. ;
   
7. 
   
8. (defun c:rule2c ( / msp el1 el2 e1 e2 n m d1 d2 sd1 sd2 key m)
   
9.   (vl-load-com)
   
10.   (vl-cmdf ".undo" "be")
    
11.   (setq
    
12.       msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
    
13.       el1 (entsel "\n第一条曲线:")
    
14.       el2 (entsel "\n第二条曲线:")
    
15.       e1 (vlax-ename->vla-object (car el1))
    
16.       e2 (vlax-ename->vla-object (car el2))
    
17.       n  (getint "\n等分数:")
    
18.       m  n
    
19.       d1 (vlax-curve-getDistAtparam e1 (vlax-curve-getendparam  e1))
    
20.       d2 (vlax-curve-getDistAtparam e2 (vlax-curve-getendparam  e2))
    
21.       sd1 (vlax-curve-getDistAtpoint e1 (vlax-curve-getClosestPointTo  e1 (cadr el1)))
    
22.       sd2 (vlax-curve-getDistAtpoint e2 (vlax-curve-getClosestPointTo  e2 (cadr el2)))
    
23.       key (if (or (and (< (/ sd1 d1) 0.5 ) (< (/ sd2 d2) 0.5))
    
24.                      (and (> (/ sd1 d1) 0.5 ) (> (/ sd2 d2) 0.5)))
    
25.                T nil)
    
26.   )
    
27.   (repeat (1+ n)
    
28.          (vla-addline msp (vlax-3d-point (vlax-curve-getPointAtDist e1 (* (/ d1 n) m)))
    
29.                           (vlax-3d-point (vlax-curve-getPointAtDist e2 (* (/ d2 n) (if key m (- n m))))))
    
30.          (setq m (1- m))
    
31.   )
    
32.   (vl-cmdf ".undo" "e")
    
33.   (princ)
    
34. )
    
35. [/font]

[font=arial]<br /> ;rule2c = 画线等分两条曲线 v2 ----------------------------陌生人.2003.12<br /> ;避开捕捉造成的错误画线.<br /> ;支持无关曲线起点终点. 根据点中曲线的位置画线.! 2004.1.7<br /> ;<br /> <br /> (defun c:rule2c ( / msp el1 el2 e1 e2 n m d1 d2 sd1 sd2 key m)<br />   (vl-load-com)<br />   (vl-cmdf ".undo" "be")<br />   (setq<br />       msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))<br />       el1 (entsel "\n第一条曲线:")<br />       el2 (entsel "\n第二条曲线:")<br />       e1 (vlax-ename->vla-object (car el1))<br />       e2 (vlax-ename->vla-object (car el2))<br />       n  (getint "\n等分数:")<br />       m  n<br />       d1 (vlax-curve-getDistAtparam e1 (vlax-curve-getendparam  e1))<br />       d2 (vlax-curve-getDistAtparam e2 (vlax-curve-getendparam  e2))<br />       sd1 (vlax-curve-getDistAtpoint e1 (vlax-curve-getClosestPointTo  e1 (cadr el1)))<br />       sd2 (vlax-curve-getDistAtpoint e2 (vlax-curve-getClosestPointTo  e2 (cadr el2)))<br />       key (if (or (and (< (/ sd1 d1) 0.5 ) (< (/ sd2 d2) 0.5))<br />                      (and (> (/ sd1 d1) 0.5 ) (> (/ sd2 d2) 0.5)))<br />                T nil)<br />   )<br />   (repeat (1+ n)<br />          (vla-addline msp (vlax-3d-point (vlax-curve-getPointAtDist e1 (* (/ d1 n) m)))<br />                           (vlax-3d-point (vlax-curve-getPointAtDist e2 (* (/ d2 n) (if key m (- n m))))))<br />          (setq m (1- m))<br />   )<br />   (vl-cmdf ".undo" "e")<br />   (princ)<br /> )<br /> [/font]

LUCAS

;;會有累積公差:(* (/ d1 n) m)
最後的線有可能不在端點上