椭圆（弧）转换为多段线弧（非直线模拟）

marting · 发表于 2017-8-2 14:45:12

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 marting 于 2017-8-2 14:49 编辑

椭圆（弧）转换为多段线弧（非直线模拟）

QQ截图20170802144119.png

加载后，执行命令：EL2PL

;; EllipseToPolyline
;; Returns a polyline (vla-object) which is an approximation of the ellipse (or elliptical arc)
;;
;; Argument : an ellipse (vla-object)
(defun EllipseToPolyline (el / cl norm cen elv pt0
pt1 pt2 pt3 pt4 ac0 ac4 a04
a02 a24 bsc0 bsc2 bsc3 bsc4 plst
blst spt spa fspa srat ept epa
fepa erat n
)
(vl-load-com)
(setq cl (= (ang<2pi (vla-get-StartAngle el))
(ang<2pi (vla-get-EndAngle el))
)
norm (vlax-get el 'Normal)
cen (trans (vlax-get el 'Center) 0 norm)
elv (caddr cen)
cen (3dTo2dPt cen)
pt0 (mapcar '+ (trans (vlax-get el 'MajorAxis) 0 norm) cen)
ac0 (angle cen pt0)
pt4 (mapcar '+ cen (trans (vlax-get el 'MinorAxis) 0 norm))
pt2 (3dTo2dPt
(trans (vlax-curve-getPointAtparam el (/ pi 4.)) 0 norm)
)
ac4 (angle cen pt4)
a04 (angle pt0 pt4)
a02 (angle pt0 pt2)
a24 (angle pt2 pt4)
bsc0 (/ (ang<2pi (- a02 ac4)) 2.)
bsc2 (/ (ang<2pi (- a04 a02)) 2.)
bsc3 (/ (ang<2pi (- a24 a04)) 2.)
bsc4 (/ (ang<2pi (- (+ ac0 pi) a24)) 2.)
pt1 (inters pt0
(polar pt0 (+ ac0 (/ pi 2.) bsc0) 1.)
pt2
(polar pt2 (+ a02 bsc2) 1.)
nil
)
pt3 (inters pt2
(polar pt2 (+ a04 bsc3) 1.)
pt4
(polar pt4 (+ a24 bsc4) 1.)
nil
)
plst (list pt4 pt3 pt2 pt1 pt0)
blst (mapcar '(lambda (b) (tan (/ b 2.)))
(list bsc4 bsc3 bsc2 bsc0)
)
)
(foreach b blst (setq blst (cons b blst)))
(foreach b blst (setq blst (cons b blst)))
(foreach p (cdr plst)
(setq ang (angle cen p)
plst (cons (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p))
plst
)
)
)
(foreach p (cdr plst)
(setq ang (angle cen p)
plst (cons (polar cen (+ ang (* 2 (- ac0 ang))) (distance cen p))
plst
)
)
)
(setq pl (vlax-invoke
(vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
'AddLightWeightPolyline
(apply 'append
(setq plst (reverse (if cl
(cdr plst)
plst
)
)
)
)
)
)
(vlax-put pl 'Normal norm)
(vla-put-Elevation pl elv)
(mapcar '(lambda (i v) (vla-SetBulge pl i v))
'(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
blst
)
(if cl
(vla-put-Closed pl :vlax-true)
(progn (setq spt (vlax-curve-getClosestPointTo pl (vlax-get el 'Startpoint))
spa (vlax-curve-getParamAtPoint pl spt)
fspa (fix spa)
ept (vlax-curve-getClosestPointTo pl (vlax-get el 'Endpoint))
epa (vlax-curve-getParamAtPoint pl ept)
fepa (fix epa)
n 0
)
(cond ((equal spt (trans pt0 norm 0) 1e-9)
(if (= epa fepa)
(setq plst (sublist plst 0 (1+ fepa))
blst (sublist blst 0 (1+ fepa))
)
(setq erat (/ (- (vlax-curve-getDistAtParam pl epa)
(vlax-curve-getDistAtParam pl fepa)
)
(- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
(vlax-curve-getDistAtParam pl fepa)
)
)
plst (append (sublist plst 0 (1+ fepa))
(list (3dTo2dPt (trans ept 0 norm)))
)
blst (append (sublist blst 0 (1+ fepa))
(list (k*bulge (nth fepa blst) erat))
)
)
)
)
((equal ept (trans pt0 norm 0) 1e-9)
(if (= spa fspa)
(setq plst (sublist plst fspa nil)
blst (sublist blst fspa nil)
)
(setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
(vlax-curve-getDistAtParam pl spa)
)
(- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
(vlax-curve-getDistAtParam pl fspa)
)
)
plst (cons (3dTo2dPt (trans spt 0 norm))
(sublist plst (1+ fspa) nil)
)
blst (cons (k*bulge (nth fspa blst) srat)
(sublist blst (1+ fspa) nil)
)
)
)
)
(T
(setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
(vlax-curve-getDistAtParam pl spa)
)
(- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
(vlax-curve-getDistAtParam pl fspa)
)
)
erat (/ (- (vlax-curve-getDistAtParam pl epa)
(vlax-curve-getDistAtParam pl fepa)
)
(- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
(vlax-curve-getDistAtParam pl fepa)
)
)
)
(if (< epa spa)
(setq plst (append (if (= spa fspa)
(sublist plst fspa nil)
(cons (3dTo2dPt (trans spt 0 norm))
(sublist plst (1+ fspa) nil)
)
)
(cdr (sublist plst 0 (1+ fepa)))
(if (/= epa fepa)
(list (3dTo2dPt (trans ept 0 norm)))
)
)
blst (append (if (= spa fspa)
(sublist blst fspa nil)
(cons (k*bulge (nth fspa blst) srat)
(sublist blst (1+ fspa) nil)
)
)
(sublist blst 0 fepa)
(if (= epa fepa)
(list (nth fepa blst))
(list (k*bulge (nth fepa blst) erat))
)
)
)
(setq plst (append (if (= spa fspa)
(sublist plst fspa (1+ (- fepa fspa)))
(cons (3dTo2dPt (trans spt 0 norm))
(sublist plst (1+ fspa) (- fepa fspa))
)
)
(list (3dTo2dPt (trans ept 0 norm)))
)
blst (append (if (= spa fspa)
(sublist blst fspa (- fepa fspa))
(cons (k*bulge (nth fspa blst) srat)
(sublist blst (1+ fspa) (- fepa fspa))
)
)
(if (= epa fepa)
(list (nth fepa blst))
(list (k*bulge (nth fepa blst) erat))
)
)
)
)
)
)
(vlax-put pl 'Coordinates (apply 'append plst))
(foreach b blst (vla-SetBulge pl n b) (setq n (1+ n)))
)
)
pl
)
;; Ang<2pi
;; Returns the angle expression betweem 0 and 2*pi
(defun ang<2pi (ang)
(if (and (<= 0 ang) (< ang (* 2 pi)))
ang
(ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
)
)
;; 3dTo2dPt
;; Returns the 2d point (x y) of a 3d point (x y z)
(defun 3dTo2dPt (pt) (list (car pt) (cadr pt)))
;; Tan
;; Returns the angle tangent
(defun tan (a) (/ (sin a) (cos a)))
;; K*BULGE
;; Returns the proportinal bulge to the référence bulge
;; Arguments :
;; b : the bulge
;; k : the proportion ratio (between angles or arcs length)
(defun k*bulge (b k / a)
(setq a (atan b))
(/ (sin (* k a)) (cos (* k a)))
)
;; EL2PL
;; Converts ellipses and elliptcal arcs into polylines
(defun c:el2pl (/ *error* fra acdoc ss)
(vl-load-com)
(defun *error* (msg)
(if (and (/= msg "Fonction annulée")
(/= msg "Function cancelled")
)
(princ (strcat (if (= "FRA" (getvar 'locale))
"\nErreur: "
"\Error: "
)
msg
)
)
)
(vla-endUndoMark acdoc)
(princ)
)
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (ssget '((0 . "ELLIPSE")))
(progn (vla-StartUndoMark acdoc)
(vlax-for e (setq ss (vla-get-ActiveSelectionSet acdoc))
(EllipseToPolyline e)
(vla-delete e)
)
(vla-delete ss)
(vla-EndUndoMark acdoc)
)
)
(princ)
)
;; PELL
;; Draws an ellipse or an elliptical arc approximation (polyline) on the fly
(defun c:pell (/ *error* ec pe old ent)
(vl-load-com)
(defun *error* (msg)
(if (and msg
(/= msg "Fonction annulée")
(/= msg "Function cancelled")
)
(princ (strcat (if (= "FRA" (getvar 'locale))
"\nErreur: "
"\Error: "
)
msg
)
)
)
(setvar 'cmdecho ec)
(setvar 'pellipse pe)
(princ)
)
(setq ec (getvar 'cmdecho)
pe (getvar 'pellipse)
old (entlast)
)
(setvar 'cmdecho 1)
(setvar 'pellipse 0)
(command "_.ellipse")
(while (/= 0 (getvar 'cmdactive)) (command pause))
(if (not (eq old (setq ent (entlast))))
(progn (EllipseToPolyline (vlax-ename->vla-object ent))
(entdel ent)
)
)
(*error* nil)
)

;; EllipseToPolyline 
;; Returns a polyline (vla-object) which is an approximation of the ellipse (or elliptical arc) 
;; 
;; Argument : an ellipse (vla-object) 
 
(defun EllipseToPolyline (el        /     cl    norm  cen        elv   pt0 
                          pt1        pt2   pt3   pt4          ac0        ac4   a04 
                          a02        a24   bsc0  bsc2  bsc3        bsc4  plst 
                          blst        spt   spa   fspa  srat        ept   epa 
                          fepa        erat  n 
                         ) 
  (vl-load-com) 
  (setq        cl   (=        (ang<2pi (vla-get-StartAngle el)) 
                (ang<2pi (vla-get-EndAngle el)) 
             ) 
        norm (vlax-get el 'Normal) 
        cen  (trans (vlax-get el 'Center) 0 norm) 
        elv  (caddr cen) 
        cen  (3dTo2dPt cen) 
        pt0  (mapcar '+ (trans (vlax-get el 'MajorAxis) 0 norm) cen) 
        ac0  (angle cen pt0) 
        pt4  (mapcar '+ cen (trans (vlax-get el 'MinorAxis) 0 norm)) 
        pt2  (3dTo2dPt 
               (trans (vlax-curve-getPointAtparam el (/ pi 4.)) 0 norm) 
             ) 
        ac4  (angle cen pt4) 
        a04  (angle pt0 pt4) 
        a02  (angle pt0 pt2) 
        a24  (angle pt2 pt4) 
        bsc0 (/ (ang<2pi (- a02 ac4)) 2.) 
        bsc2 (/ (ang<2pi (- a04 a02)) 2.) 
        bsc3 (/ (ang<2pi (- a24 a04)) 2.) 
        bsc4 (/ (ang<2pi (- (+ ac0 pi) a24)) 2.) 
        pt1  (inters pt0 
                     (polar pt0 (+ ac0 (/ pi 2.) bsc0) 1.) 
                     pt2 
                     (polar pt2 (+ a02 bsc2) 1.) 
                     nil 
             ) 
        pt3  (inters pt2 
                     (polar pt2 (+ a04 bsc3) 1.) 
                     pt4 
                     (polar pt4 (+ a24 bsc4) 1.) 
                     nil 
             ) 
        plst (list pt4 pt3 pt2 pt1 pt0) 
        blst (mapcar '(lambda (b) (tan (/ b 2.))) 
                     (list bsc4 bsc3 bsc2 bsc0) 
             ) 
  ) 
  (foreach b blst (setq blst (cons b blst))) 
  (foreach b blst (setq blst (cons b blst))) 
  (foreach p (cdr plst) 
    (setq ang  (angle cen p) 
          plst (cons (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p)) 
                     plst 
               ) 
    ) 
  ) 
  (foreach p (cdr plst) 
    (setq ang  (angle cen p) 
          plst (cons (polar cen (+ ang (* 2 (- ac0 ang))) (distance cen p)) 
                     plst 
               ) 
    ) 
  ) 
  (setq        pl (vlax-invoke 
             (vla-get-ModelSpace 
               (vla-get-ActiveDocument (vlax-get-acad-object)) 
             ) 
             'AddLightWeightPolyline 
             (apply 'append 
                    (setq plst (reverse        (if cl 
                                          (cdr plst) 
                                          plst 
                                        ) 
                               ) 
                    ) 
             ) 
           ) 
  ) 
  (vlax-put pl 'Normal norm) 
  (vla-put-Elevation pl elv) 
  (mapcar '(lambda (i v) (vla-SetBulge pl i v)) 
          '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) 
          blst 
  ) 
  (if cl 
    (vla-put-Closed pl :vlax-true) 
    (progn (setq spt  (vlax-curve-getClosestPointTo pl (vlax-get el 'Startpoint)) 
                 spa  (vlax-curve-getParamAtPoint pl spt) 
                 fspa (fix spa) 
                 ept  (vlax-curve-getClosestPointTo pl (vlax-get el 'Endpoint)) 
                 epa  (vlax-curve-getParamAtPoint pl ept) 
                 fepa (fix epa) 
                 n    0 
           ) 
           (cond ((equal spt (trans pt0 norm 0) 1e-9) 
                  (if (= epa fepa) 
                    (setq plst (sublist plst 0 (1+ fepa)) 
                          blst (sublist blst 0 (1+ fepa)) 
                    ) 
                    (setq erat (/ (- (vlax-curve-getDistAtParam pl epa) 
                                     (vlax-curve-getDistAtParam pl fepa) 
                                  ) 
                                  (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17)) 
                                     (vlax-curve-getDistAtParam pl fepa) 
                                  ) 
                               ) 
                          plst (append (sublist plst 0 (1+ fepa)) 
                                       (list (3dTo2dPt (trans ept 0 norm))) 
                               ) 
                          blst (append (sublist blst 0 (1+ fepa)) 
                                       (list (k*bulge (nth fepa blst) erat)) 
                               ) 
                    ) 
                  ) 
                 ) 
                 ((equal ept (trans pt0 norm 0) 1e-9) 
                  (if (= spa fspa) 
                    (setq plst (sublist plst fspa nil) 
                          blst (sublist blst fspa nil) 
                    ) 
                    (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17)) 
                                     (vlax-curve-getDistAtParam pl spa) 
                                  ) 
                                  (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17)) 
                                     (vlax-curve-getDistAtParam pl fspa) 
                                  ) 
                               ) 
                          plst (cons (3dTo2dPt (trans spt 0 norm)) 
                                     (sublist plst (1+ fspa) nil) 
                               ) 
                          blst (cons (k*bulge (nth fspa blst) srat) 
                                     (sublist blst (1+ fspa) nil) 
                               ) 
                    ) 
                  ) 
                 ) 
                 (T 
                  (setq        srat (/        (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17)) 
                                   (vlax-curve-getDistAtParam pl spa) 
                                ) 
                                (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17)) 
                                   (vlax-curve-getDistAtParam pl fspa) 
                                ) 
                             ) 
                        erat (/        (- (vlax-curve-getDistAtParam pl epa) 
                                   (vlax-curve-getDistAtParam pl fepa) 
                                ) 
                                (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17)) 
                                   (vlax-curve-getDistAtParam pl fepa) 
                                ) 
                             ) 
                  ) 
                  (if (< epa spa) 
                    (setq plst (append (if (= spa fspa) 
                                         (sublist plst fspa nil) 
                                         (cons (3dTo2dPt (trans spt 0 norm)) 
                                               (sublist plst (1+ fspa) nil) 
                                         ) 
                                       ) 
                                       (cdr (sublist plst 0 (1+ fepa))) 
                                       (if (/= epa fepa) 
                                         (list (3dTo2dPt (trans ept 0 norm))) 
                                       ) 
                               ) 
                          blst (append (if (= spa fspa) 
                                         (sublist blst fspa nil) 
                                         (cons (k*bulge (nth fspa blst) srat) 
                                               (sublist blst (1+ fspa) nil) 
                                         ) 
                                       ) 
                                       (sublist blst 0 fepa) 
                                       (if (= epa fepa) 
                                         (list (nth fepa blst)) 
                                         (list (k*bulge (nth fepa blst) erat)) 
                                       ) 
                               ) 
                    ) 
                    (setq plst (append (if (= spa fspa) 
                                         (sublist plst fspa (1+ (- fepa fspa))) 
                                         (cons (3dTo2dPt (trans spt 0 norm)) 
                                               (sublist plst (1+ fspa) (- fepa fspa)) 
                                         ) 
                                       ) 
                                       (list (3dTo2dPt (trans ept 0 norm))) 
                               ) 
                          blst (append (if (= spa fspa) 
                                         (sublist blst fspa (- fepa fspa)) 
                                         (cons (k*bulge (nth fspa blst) srat) 
                                               (sublist blst (1+ fspa) (- fepa fspa)) 
                                         ) 
                                       ) 
                                       (if (= epa fepa) 
                                         (list (nth fepa blst)) 
                                         (list (k*bulge (nth fepa blst) erat)) 
                                       ) 
                               ) 
                    ) 
                  ) 
                 ) 
           ) 
           (vlax-put pl 'Coordinates (apply 'append plst)) 
           (foreach b blst (vla-SetBulge pl n b) (setq n (1+ n))) 
    ) 
  ) 
  pl 
) 
 
;; Ang<2pi 
;; Returns the angle expression betweem 0 and 2*pi 
(defun ang<2pi (ang) 
  (if (and (<= 0 ang) (< ang (* 2 pi))) 
    ang 
    (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi))) 
  ) 
) 
 
;; 3dTo2dPt 
;; Returns the 2d point (x y) of a 3d point (x y z) 
(defun 3dTo2dPt (pt) (list (car pt) (cadr pt))) 
 
;; Tan 
;; Returns the angle tangent 
(defun tan (a) (/ (sin a) (cos a))) 
 
 
 
;; K*BULGE 
;; Returns the proportinal bulge to the référence bulge 
;; Arguments : 
;; b : the bulge 
;; k : the proportion ratio (between angles or arcs length) 
(defun k*bulge (b k / a) 
  (setq a (atan b)) 
  (/ (sin (* k a)) (cos (* k a))) 
) 
 
;; EL2PL 
;; Converts ellipses and elliptcal arcs into polylines 
 
(defun c:el2pl (/ *error* fra acdoc ss) 
  (vl-load-com) 
  (defun *error* (msg) 
    (if        (and (/= msg "Fonction annulée") 
             (/= msg "Function cancelled") 
        ) 
      (princ (strcat (if (= "FRA" (getvar 'locale)) 
                       "\nErreur: " 
                       "\Error: " 
                     ) 
                     msg 
             ) 
      ) 
    ) 
    (vla-endUndoMark acdoc) 
    (princ) 
  ) 
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) 
  (if (ssget '((0 . "ELLIPSE"))) 
    (progn (vla-StartUndoMark acdoc) 
           (vlax-for e (setq ss (vla-get-ActiveSelectionSet acdoc)) 
             (EllipseToPolyline e) 
             (vla-delete e) 
           ) 
           (vla-delete ss) 
           (vla-EndUndoMark acdoc) 
    ) 
  ) 
  (princ) 
) 
 
;; PELL 
;; Draws an ellipse or an elliptical arc approximation (polyline) on the fly 
(defun c:pell (/ *error* ec pe old ent) 
  (vl-load-com) 
  (defun *error* (msg) 
    (if        (and msg 
             (/= msg "Fonction annulée") 
             (/= msg "Function cancelled") 
        ) 
      (princ (strcat (if (= "FRA" (getvar 'locale)) 
                       "\nErreur: " 
                       "\Error: " 
                     ) 
                     msg 
             ) 
      ) 
    ) 
    (setvar 'cmdecho ec) 
    (setvar 'pellipse pe) 
    (princ) 
  ) 
  (setq        ec  (getvar 'cmdecho) 
        pe  (getvar 'pellipse) 
        old (entlast) 
  ) 
  (setvar 'cmdecho 1) 
  (setvar 'pellipse 0) 
  (command "_.ellipse") 
  (while (/= 0 (getvar 'cmdactive)) (command pause)) 
  (if (not (eq old (setq ent (entlast)))) 
    (progn (EllipseToPolyline (vlax-ename->vla-object ent)) 
           (entdel ent) 
    ) 
  ) 
  (*error* nil) 
)

函数 sublist ：

;; SUBLIST
;; Returns a sub list
;;
;; Arguments
;; lst : a list
;; start : start index (first item = 0)
;; leng : the sub list length (number of items) or nil
(defun sublist (lst start leng / n r)
(if (or (not leng) (< (- (length lst) start) leng))
(setq leng (- (length lst) start))
)
(setq n (+ start leng))
(while (< start n)
(setq r (cons (nth (setq n (1- n)) lst) r))
)
)

sicky111 · 发表于 2017-8-3 00:08:30

沙发，正需要，太感谢了。

fanpaulm · 发表于 2017-8-3 07:12:17

这个太有用了，感谢分享!

liunian0524 · 发表于 2017-8-3 08:14:50

感谢大大分享

小陶 · 发表于 2017-8-3 11:37:03

sicky111 发表于 2017-8-3 00:08

佑达升级了没?

livewin · 发表于 2017-8-14 21:02:14

感谢分享，正需要

pezyl · 发表于 2017-8-15 09:37:31

工作中很有帮助，给力

ray7891 · 发表于 2017-10-18 10:31:31

加载后未知命令？

rodger · 发表于 2017-10-31 16:44:57

怎么运行不起来呢？求有经验的给介绍

yansu · 发表于 2017-11-15 09:41:31

感谢大大分享

龙吟舞 · 发表于 2017-12-16 15:46:52

能否转换后是多段圆弧或是圆弧，而不是闭合的多段线

caiqijun0818 · 发表于 2018-1-4 14:31:48

好贴必须顶

gdfyhao · 发表于 2019-5-25 09:33:11

还是多段线编辑起来方便，谢谢分享

风青c · 发表于 2019-6-6 22:41:55

marting LV5
2017-8-2 14:45:12 楼主
椭圆（弧）转换为多段线弧（非直线模拟）
椭圆（弧）转换为多段线弧（非直线模拟）

来自: 微社区

kqqt6236 · 发表于 2019-6-10 00:50:13

这个收藏了。

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

[每日一码] 椭圆（弧）转换为多段线弧（非直线模拟）

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。