关于多段线

lucas_3333 · 发表于 2014-4-7 21:51

楼盖了这么高了，看看

USER2128 · 发表于 2014-4-8 08:36

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

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

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

ou_y_x · 发表于 2014-4-8 10:36

学习了。。。。。

CAD_lso · 发表于 2014-4-9 14:19

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

wzg356 · 发表于 2014-4-9 23:50

感谢，涨姿势了

ansysdede · 发表于 2014-4-10 07:22

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

328302216 · 发表于 2014-4-11 17:35

黄老师辛苦了！

vlisp2012 · 发表于 2014-4-11 20:45

量产大师！！！

friendship12c · 发表于 2014-4-13 19:28

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

434939575 · 发表于 2014-4-15 09:03

大力支持。大公无私。

账号		自动登录	找回密码
密码			注册

[讨论] 关于多段线