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

楼盖了这么高了，看看

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

;;; 程序整理BY USER2128（HLCAD），欢迎使用。;;; 返回多段线凸度处的 （圆心点坐标    半径起始角   终止角）
;|
Ex:
(mapcar (function (lambda(x) (apply 'cvtbulge x)))
        (mapcar 'cdr (plarcinfo (entget (car (entsel))))))
==> (((1746.88 1442.56) 100.0 1.839052.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 (carsp) x2 (carep))
(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:39

学习了。。。。。

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

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

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

感谢，涨姿势了

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

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

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

黄老师辛苦了！

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

量产大师！！！

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

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

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

大力支持。大公无私。
页: 1 2 3 4 5 6 7 8 9 10 [11] 12 13 14 15 16 17 18 19 20
查看完整版本: 关于多段线