两线平行时,画对称中心线

自贡黄明儒

1. ;;两线平行时，画梯形腰线
   
2. (defun HH:waist        (en1 en2 / E1EN E1ST E2EN E2ST LST P0 P1E P1S P2E P2S P3 X Y)
   
3.   (setq e1st (vlax-curve-getStartPoint en1))
   
4.   (setq e1en (vlax-curve-getendPoint en1))
   
5.   (setq e2st (vlax-curve-getStartPoint en2))
   
6.   (setq e2en (vlax-curve-getendPoint en2))
   
7.   (setq        lst (list (list (distance e1st e2st) e1st e2st)
   
8.                   (list (distance e1st e2en) e1st e2en)
   
9.                   (list (distance e1en e2st) e1en e2st)
   
10.                   (list (distance e1en e2en) e1en e2en)
    
11.             )
    
12.   )
    
13.   ;;http://www.xdcad.net/forum/thread-670556-1-4.html HH:ssPts:Sort定义
    
14.   (setq lst (car (mapcar 'cdr (HH:ssPts:Sort lst "X" 0.0001)))) ;最远两点
    
15.   (if (equal (car lst) e1st 0.0001)
    
16.     (setq p1s e1st
    
17.           p1e e1en
    
18.     )
    
19.     (setq p1s e1en
    
20.           p1e e1st
    
21.     )
    
22.   )
    
23.   (if (equal (cadr lst) e2st 0.0001)
    
24.     (setq p2s e2en
    
25.           p2e e2en
    
26.     )
    
27.     (setq p2s e2st
    
28.           p2e e2en
    
29.     )
    
30.   )
    
31. 
    
32.   (setq P0 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1s p2s))
    
33.   (setq P3 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1e p2e))
    
34.   (entmake (list (cons 0 "LINE") (cons 10 P0) (cons 11 P3)))
    
35. )
    
36. 
    
37. (defun C:W2 (/ EN1 EN2)
    
38.   (setq en1 (car (entsel)))
    
39.   (setq en2 (car (entsel)))
    
40.   (HH:waist en1 en2)
    
41.   (princ)
    
42. )

;;两线平行时，画梯形腰线<br /> (defun HH:waist        (en1 en2 / E1EN E1ST E2EN E2ST LST P0 P1E P1S P2E P2S P3 X Y)<br />   (setq e1st (vlax-curve-getStartPoint en1))<br />   (setq e1en (vlax-curve-getendPoint en1))<br />   (setq e2st (vlax-curve-getStartPoint en2))<br />   (setq e2en (vlax-curve-getendPoint en2))<br />   (setq        lst (list (list (distance e1st e2st) e1st e2st)<br />                   (list (distance e1st e2en) e1st e2en)<br />                   (list (distance e1en e2st) e1en e2st)<br />                   (list (distance e1en e2en) e1en e2en)<br />             )<br />   )<br />   ;;<a href="http://www.xdcad.net/forum/thread-670556-1-4.html" target="_blank">http://www.xdcad.net/forum/thread-670556-1-4.html</a> HH:ssPts:Sort定义<br />   (setq lst (car (mapcar 'cdr (HH:ssPts:Sort lst "X" 0.0001)))) ;最远两点<br />   (if (equal (car lst) e1st 0.0001)<br />     (setq p1s e1st<br />           p1e e1en<br />     )<br />     (setq p1s e1en<br />           p1e e1st<br />     )<br />   )<br />   (if (equal (cadr lst) e2st 0.0001)<br />     (setq p2s e2en<br />           p2e e2en<br />     )<br />     (setq p2s e2st<br />           p2e e2en<br />     )<br />   )<br /> <br />   (setq P0 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1s p2s))<br />   (setq P3 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1e p2e))<br />   (entmake (list (cons 0 "LINE") (cons 10 P0) (cons 11 P3)))<br /> )<br /> <br /> (defun C:W2 (/ EN1 EN2)<br />   (setq en1 (car (entsel)))<br />   (setq en2 (car (entsel)))<br />   (HH:waist en1 en2)<br />   (princ)<br /> )

llsheng_73

“两线平行时,画对称中心线”我怎么没看到老黄判断那两条线是否平行

llsheng_73

1. (defun HH:waist        (en1 en2 /  P0 P1E P1S P2E P2S P3)
   
2.   (setq p1s (vlax-curve-getStartPoint en1)
   
3.   p1e (vlax-curve-getendPoint en1)
   
4.   p2s (vlax-curve-getStartPoint en2)
   
5.   p2e (vlax-curve-getendPoint en2))
   
6.   (if(inters p1s p2s p1e p2e)
   
7.     (setq p0(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1s p2e)
   
8.     p3(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1e p2s))
   
9.     (setq p0(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1s p2s)
   
10.     p3(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1e p2e))
    
11.     )
    
12.   (entmake (list (cons 0 "LINE") (cons 10 P0) (cons 11 P3)))
    
13. )
    
14. 
    
15. 
    
16. (defun C:W2 (/ EN1 EN2)
    
17.   (setq en1 (car (entsel)))
    
18.   (setq en2 (car (entsel)))
    
19.   (HH:waist en1 en2)
    
20.   (princ)
    
21. )

(defun HH:waist        (en1 en2 /  P0 P1E P1S P2E P2S P3)<br />   (setq p1s (vlax-curve-getStartPoint en1)<br />   p1e (vlax-curve-getendPoint en1)<br />   p2s (vlax-curve-getStartPoint en2)<br />   p2e (vlax-curve-getendPoint en2))<br />   (if(inters p1s p2s p1e p2e)<br />     (setq p0(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1s p2e)<br />     p3(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1e p2s))<br />     (setq p0(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1s p2s)<br />     p3(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1e p2e))<br />     )<br />   (entmake (list (cons 0 "LINE") (cons 10 P0) (cons 11 P3)))<br /> )<br /> <br /> <br /> (defun C:W2 (/ EN1 EN2)<br />   (setq en1 (car (entsel)))<br />   (setq en2 (car (entsel)))<br />   (HH:waist en1 en2)<br />   (princ)<br /> )

给你小改了下。。。我也不检查它们是否平行

llsheng_73

llsheng_73 发表于 2013-11-19 10:01
给你小改了下。。。我也不检查它们是否平行

我不是判断它们是否平行，我只是把你判短用那两个点计算中点的过程改了一下

baokeding

两线平行时,画对称中心线

xyp1964

baokeding

E:\cg\AutoCAD_2014_Simplified_Chinese_Win_64bit_dlm\x64\acad

下文没句号。

这么好的程序，值得下载学习。

myhomer

学习一下，感谢分享