关于多段线

lucas_3333

楼盖了这么高了，看看

USER2128

;;; 程序整理BY USER2128（HLCAD），欢迎使用。

2. ;;; 返回多段线凸度处的 （圆心点坐标    半径  起始角   终止角）
   
3. ;|
   
4. Ex:
   
5. (mapcar (function (lambda(x) (apply 'cvtbulge x)))
   
6.         (mapcar 'cdr (plarcinfo (entget (car (entsel))))))
   
7. ==> (((1746.88 1442.56) 100.0 1.83905  2.86187)
   
8.      ((1775.67 1450.48) 100.0 0.268258 1.83905))
   
9.         （圆心点坐标    半径  起始角   终止角）
   
10. |;
    
11. (defun cvtbulge (sp bulge ep / cotbce x1 x2 y1 y2 temp
    
12.                  cen rad sa ea)
    
13.   (setq x1 (car  sp) x2 (car  ep))
    
14.   (setq y1 (cadr sp) y2 (cadr ep))
    
15.   (setq cotbce (/ (- (/ 1.0 bulge) bulge) 2.0))
    
16.   
    
17. ; Compute center point and radius
    
18.   (setq cen (list (/ (+ x1 x2 (- (* (- y2 y1) cotbce))) 2.0)
    
19.                   (/ (+ y1 y2    (* (- x2 x1) cotbce) ) 2.0))
    
20.         )
    
21.   (setq rad (distance cen sp))
    
22.   
    
23. ; Compute start and end angles
    
24.   (setq sa  (atan (- y1 (cadr cen)) (- x1 (car cen))))
    
25.   (setq ea  (atan (- y2 (cadr cen)) (- x2 (car cen))))
    
26.   (if (< sa 0.0)                      ; Eliminate negative angles
    
27.     (setq sa (+ sa (* 2.0 pi)))
    
28.     )
    
29.   (if (< ea 0.0)
    
30.     (setq ea (+ ea (* 2.0 pi)))
    
31.     )
    
32.   (if (< bulge 0.0)                   ; Swap angles if clockwise
    
33.     (progn
    
34.       (setq temp sa)
    
35.       (setq sa ea)
    
36.       (setq ea temp)
    
37.       )
    
38.     )
    
39.   (list cen rad sa ea)
    
40.   )
    
41. ;;; =============================================
    
42. ;;;程序得到多段线在哪个顶点开始有圆弧，并且圆弧的信息。
    
43. ;;; (plarcinfo (entget (car (entsel))))
    
44. ;  ==> ((2 (1566.14 815.301 0.0) 0.567253 (1625.41 877.383 0.0))
    
45. ;       (4 (1537.78 1194.31 0.0) 0.414214 (1476.26 1229.18 0.0)))
    
46. (defun plarcinfo (el / i lst bl)
    
47.   (setq i -1)
    
48.   (if (setq lst (vl-remove nil
    
49.       (mapcar
    
50.         (function (lambda (y) (setq i (1+ i)) (if (zerop y) nil i)))
    
51.         (setq bl(mapcar 'cdr(vl-remove-if-not '(lambda(x)(=(car x)42))el)))
    
52.         )))
    
53.     (mapcar 'cons lst
    
54.             (mapcar '(lambda (x y)
    
55.                        (setq e (cdr (assoc -1 el)))
    
56.                        (list (vlax-curve-getpointatparam e x)
    
57.                              y
    
58.                              (vlax-curve-getpointatparam e (1+ x))
    
59.                              )
    
60.                        ) lst (vl-remove 0. bl))
    
61.             )
    
62.     )
    
63.   )
    
64. ;;; =============================================
    

;;; 返回多段线凸度处的 （圆心点坐标    半径  起始角   终止角）<br /> ;|<br /> Ex:<br /> (mapcar (function (lambda(x) (apply 'cvtbulge x)))<br />         (mapcar 'cdr (plarcinfo (entget (car (entsel))))))<br /> ==> (((1746.88 1442.56) 100.0 1.83905  2.86187)<br />      ((1775.67 1450.48) 100.0 0.268258 1.83905))<br />         （圆心点坐标    半径  起始角   终止角）<br /> |;<br /> (defun cvtbulge (sp bulge ep / cotbce x1 x2 y1 y2 temp<br />                  cen rad sa ea)<br />   (setq x1 (car  sp) x2 (car  ep))<br />   (setq y1 (cadr sp) y2 (cadr ep))<br />   (setq cotbce (/ (- (/ 1.0 bulge) bulge) 2.0))<br />   <br /> ; Compute center point and radius<br />   (setq cen (list (/ (+ x1 x2 (- (* (- y2 y1) cotbce))) 2.0)<br />                   (/ (+ y1 y2    (* (- x2 x1) cotbce) ) 2.0))<br />         )<br />   (setq rad (distance cen sp))<br />   <br /> ; Compute start and end angles<br />   (setq sa  (atan (- y1 (cadr cen)) (- x1 (car cen))))<br />   (setq ea  (atan (- y2 (cadr cen)) (- x2 (car cen))))<br />   (if (< sa 0.0)                      ; Eliminate negative angles<br />     (setq sa (+ sa (* 2.0 pi)))<br />     )<br />   (if (< ea 0.0)<br />     (setq ea (+ ea (* 2.0 pi)))<br />     )<br />   (if (< bulge 0.0)                   ; Swap angles if clockwise<br />     (progn<br />       (setq temp sa)<br />       (setq sa ea)<br />       (setq ea temp)<br />       )<br />     )<br />   (list cen rad sa ea)<br />   )<br /> ;;; =============================================<br /> ;;;程序得到多段线在哪个顶点开始有圆弧，并且圆弧的信息。<br /> ;;; (plarcinfo (entget (car (entsel))))<br /> ;  ==> ((2 (1566.14 815.301 0.0) 0.567253 (1625.41 877.383 0.0))<br /> ;       (4 (1537.78 1194.31 0.0) 0.414214 (1476.26 1229.18 0.0)))<br /> (defun plarcinfo (el / i lst bl)<br />   (setq i -1)<br />   (if (setq lst (vl-remove nil<br />       (mapcar<br />         (function (lambda (y) (setq i (1+ i)) (if (zerop y) nil i)))<br />         (setq bl(mapcar 'cdr(vl-remove-if-not '(lambda(x)(=(car x)42))el)))<br />         )))<br />     (mapcar 'cons lst<br />             (mapcar '(lambda (x y)<br />                        (setq e (cdr (assoc -1 el)))<br />                        (list (vlax-curve-getpointatparam e x)<br />                              y<br />                              (vlax-curve-getpointatparam e (1+ x))<br />                              )<br />                        ) lst (vl-remove 0. bl))<br />             )<br />     )<br />   )<br /> ;;; =============================================<br />

ou_y_x

学习了。。。。。

CAD_lso

多谢楼主 看到几个非常实用的

wzg356

感谢，涨姿势了

ansysdede

学习一下这个命令，感觉挺有用的。

328302216

黄老师  辛苦了！

vlisp2012

量产大师！！！

friendship12c

回复看看是神马东东！！...

434939575

大力支持。大公无私。