TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: gile on November 08, 2009, 04:06:31 PM

Title: Ellipses to polylines
Post by: gile on November 08, 2009, 04:06:31 PM

Hi,

I think I found the way AutoCAD approximates ellipses using polylines (arcs) while PELLIPSE is set to 1.

Here's an EllipseToPolyline routine which creates a polyline which matches the ellipse (the routine doesn't delete the ellipse).
It works with elliptical arcs.
It works whatever the ellipse construction plane.

 

Code: [Select]

;; 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)))

;; 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))
  )
)

;; 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)))
)
And two commands:
EL2PL to transform selected ellipses into polylines
PELL to draw an 'elliptical polyline' on the fly

Code: [Select]

;; 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)
)

Title: Re: Ellipses to polylines
Post by: cjw on November 09, 2009, 04:33:45 AM

Very nice code,gile. 8-)

Here is easy way.

Code: [Select]

;;Ellipses to polylines By cjw 11/9/09
(defun C:EL2PL (/ E E1 E2 O)
  (setq E (car (entsel "\nSelect the ellipse: ")))
  (setq O (vlax-ename->vla-object E))
  (vla-offset O 0.1)
  (setq E1 (entlast))
  (vla-offset (vlax-ename->vla-object E1) -0.1)
  (setq E2 (entlast))
  (entdel E)
  (entdel E1)
  (princ)
)


Title: Re: Ellipses to polylines
Post by: gile on November 09, 2009, 06:19:42 AM

Thanks cjw

AFAIK (but my knowledge isn't so great), offsting an ellipse creates a spline, not a polyline.

Title: Re: Ellipses to polylines
Post by: Hedgehog on November 09, 2009, 06:46:20 AM

Double click the spline & convert to a polyline... or add a line of code to do that  :-)

Title: Re: Ellipses to polylines
Post by: gile on November 09, 2009, 07:15:14 AM

Quote from: Hedgehog on November 09, 2009, 06:46:20 AM

Double click the spline & convert to a polyline... or add a line of code to do that  :-)

Not prior A2010 :-(

Title: Re: Ellipses to polylines
Post by: Hedgehog on November 09, 2009, 07:23:27 AM

... oops  :-(

Title: Re: Ellipses to polylines
Post by: gile on November 09, 2009, 04:30:23 PM

I tried the offset, offset back an splinedit method on a 2010 version.
Even specifying the lowest precision (1) I got a 257 vertices polyline.

Title: Re: Ellipses to polylines
Post by: cjw on November 09, 2009, 07:36:37 PM

Quote from: gile on November 09, 2009, 06:19:42 AM

Thanks cjw

AFAIK (but my knowledge isn't so great), offsting an ellipse creates a spline, not a polyline.

I am sorry! :-(

Thanks.

Title: Re: Ellipses to polylines
Post by: luiscarneirorm on October 18, 2011, 09:31:11 AM

Quote from: gile on November 08, 2009, 04:06:31 PM

Hi,

I think I found the way AutoCAD approximates ellipses using polylines (arcs) while PELLIPSE is set to 1.

Here's an EllipseToPolyline routine which creates a polyline which matches the ellipse (the routine doesn't delete the ellipse).
It works with elliptical arcs.
It works whatever the ellipse construction plane.

 

Code: [Select]

;; 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   (and (= (vla-get-StartAngle el) 0.0)
                  (= (vla-get-EndAngle el) (* 2 pi))
             )
        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 (1+ fepa))
                       (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 (1+ fspa))
                            (vlax-curve-getDistAtParam pl spa)
                         )
                         (- (vlax-curve-getDistAtParam pl (1+ fspa))
                            (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 (1+ fspa))
                            (vlax-curve-getDistAtParam pl spa)
                         )
                         (- (vlax-curve-getDistAtParam pl (1+ fspa))
                            (vlax-curve-getDistAtParam pl fspa)
                         )
                      )
               erat (/ (- (vlax-curve-getDistAtParam pl epa)
                       (vlax-curve-getDistAtParam pl fepa)
                    )
                    (- (vlax-curve-getDistAtParam pl (1+ fepa))
                       (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 beweem 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)))

;; 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))
  )
)

;; 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)))
)
And two commands:
EL2PL to transform selected ellipses into polylines
PELL to draw an 'elliptical polyline' on the fly

Code: [Select]

;; 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)
)

Hi. Sorry for digging up the topic, but needed help with this routine, I am using this routine to convert arcs of ellipse to polylines, but I'm having problems with the arcs of ellipse that have start angle 0 and end angle 180  :x.
the curious thing is that if I change these values ​​to others, and then replacing the original values ​​and execute the routine she now works correctly.

Title: Re: Ellipses to polylines
Post by: luiscarneirorm on October 18, 2011, 10:00:48 AM

I think I've detected the problem, I went to see the code dxf arc that was giving me problems and found the following:
(40 . 0.240816) (41 . -1.87175e-007) (42 . 3.14176))
the value in bold corresponds to the start angle and should be 0. it's possible to contour that problem???

Title: Re: Ellipses to polylines
Post by: gile on October 18, 2011, 11:57:56 AM

Hi,

I do not understand your request.
Can you explain more deeply why do you think the routine doesn't work as expected.

You're talking about the ellipse start angle which does not seem to be as you want.
The routine does not deals with the elliptical arc angles, only with start point and end point.

Title: Re: Ellipses to polylines
Post by: luiscarneirorm on October 18, 2011, 12:14:08 PM

Quote from: gile on October 18, 2011, 11:57:56 AM

Hi,

I do not understand your request.
Can you explain more deeply why do you think the routine doesn't work as expected.

You're talking about the ellipse start angle which does not seem to be as you want.
The routine does not deals with the elliptical arc angles, only with start point and end point.

Code: [Select]

(setq cl   (and (= (vla-get-StartAngle el) 0.0)
                  (= (vla-get-EndAngle el) (* 2 pi))
             )
Humm???

I put here the case that is giving me problems, it may be easier for you to understand, because my English is very bad.


If you see the proprieties of the arc, the start angle it's 0, and the end angle its 180, so the dxf code should be:
(41 . 0.0) (42 . 3.14176))
and it is
(41 . -1.87175e-007) (42 . 3.14176))

I'm newbie in lisp, but I think the problem is there.

Title: Re: Ellipses to polylines
Post by: gile on October 18, 2011, 12:30:40 PM

This expression is only used to evaluate if the ellipse is closed.
While dealing with elliptical arcs (i.e. non closed ellipses) the code only used the ellipse start point and end point to 'break' the polyline.

The example you give shows that the elliptical arc is not exactly starting with a 0.0 angle. It looks like it is your elliptical arc which isn't very accurate, not the LISP...

Title: Re: Ellipses to polylines
Post by: luiscarneirorm on October 18, 2011, 12:36:39 PM

Quote from: gile on October 18, 2011, 12:30:40 PM

This expression is only used to evaluate if the ellipse is closed.
While dealing with elliptical arcs (i.e. non closed ellipses) the code only used the ellipse start point and end point to 'break' the polyline.

The example you give shows that the elliptical arc is not exactly starting with a 0.0 angle. It looks like it is your elliptical arc which isn't very accurate, not the LISP...

hum, ok...
You try tu use the function in this arc? she work's ok for you???

Title: Re: Ellipses to polylines
Post by: gile on October 18, 2011, 12:39:37 PM

Quote

hum, ok...
You try tu use the function in this arc? she work's ok for you???

What arc are you talking about ?
Post a drawing example, please.

Title: Re: Ellipses to polylines
Post by: luiscarneirorm on October 18, 2011, 12:41:36 PM

it's in the 11# post  8-)


P.S: even now, if I draw an ellipse, and then stretch it or shrink it, sometimes the start angle and end angle is no longer 0 and 360, and become for example 90 90, or 180 180, and then to use function gives me problems ...
You can work around this??

Title: Re: Ellipses to polylines
Post by: gile on October 18, 2011, 01:11:29 PM

Try this one

Code: [Select]

;; 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)))

;; 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))
  )
)

;; 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)))
)

Title: Re: Ellipses to polylines
Post by: kraz on October 19, 2011, 12:28:21 AM

very nice prog.
and here my easy way...but not better than gile.
spline or elipse -> polyline

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun KZ:GetSPlineVertex (spl n / obj len vd p sum)
 (if (> n 1)
  (progn
   (if (= (type spl) 'ename)
    (setq obj (vlax-ename->vla-object spl))
    (setq obj spl)
   )
   ;(setq len (ade_expreval (vlax-vla-object->ename obj) ".length" "real"))
   (setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)))
   (setq vd (/ len n) sum 0 plist '())
   (repeat (1+ n)
    (setq p (vlax-curve-getPointAtDist obj sum))
    (setq p (list (car p)(cadr p)))
    (if (not (member p plist)) (setq plist (append plist (list p))))
    (setq sum (+ sum vd))
   );rep
   plist
  )
  nil
 )
)
(defun c:test( / es cls vtxs n obj pl)
 (vl-cmdf ".undo" "begin")
 (if (setq es (car (entsel "\nSelect Entity... ")))
  (progn
   (setq n (getint "\nHow many vertex[Default:15]... "))
   (if (or (null n) (< n 2)) (setq n 15))
   (setq obj (vlax-ename->vla-object es))
   (if (and (vlax-property-available-p obj 'closed)
            (= (vlax-get-property (vlax-ename->vla-object es) 'closed) :vlax-true)
       )
    (setq cls 1)
    (setq cls 0)
   );if
   (setq vtxs (KZ:GetSPlineVertex es (1- n)));make n vertexs
   (setq pl (make_pline vtxs (getvar "clayer") 62 cls))
   (entdel es)
  )
 );if
 (vl-cmdf ".undo" "end")
 (princ)
);end defun

Title: Re: Ellipses to polylines
Post by: luiscarneirorm on October 19, 2011, 03:53:16 AM

Quote from: gile on October 18, 2011, 01:11:29 PM

Try this one

Code: [Select]

;; 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)))

;; 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))
  )
)

;; 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)))
)

Tk you very much... I've been doing some testing and so far it is working properly ... I will try to adapt it to my script to handle all the drawing ellipses automatically ...

Title: Re: Ellipses to polylines
Post by: Andrea on November 18, 2011, 10:48:35 AM

Hi Gile,

Thank you for sharing the code,....
I've made a little modification...(if you don't mind)

Code: [Select]

(if (eq (getvar 'tilemode) 1)             
             (setq vlaLayout (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
             (setq vlaLayout (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
           )
  (setq pl
(vlax-invoke
   vlaLayout
   'AddLightWeightPolyline
   (apply 'append
  (setq plst
(reverse (if cl
    (cdr plst)
    plst
  )
)
  )
   )
)
  )
I tough this was forget..
 :wink:

Title: Re: Ellipses to polylines
Post by: gile on November 18, 2011, 11:09:27 AM

Thanks for correcting this Andrea.
By my side, I prefer use the object owner in case the object have been selected in an active paper space viewport (i.e. TILEMODE = 1 and CVPORT /= 1)

Code: [Select]

(setq vlaLayout (vla-ObjectIdToObject *acdoc* (vla-get-OwnerId obj)))

Title: Re: Ellipses to polylines
Post by: Andrea on November 18, 2011, 11:44:18 AM

I'm not as skilled..   :blank:

thanks !

Title: Re: Ellipses to polylines
Post by: MP on November 18, 2011, 11:48:08 AM

Somewhat tangential, but on the topic of ObjectIDToObject .... this is what I have in my library:

Code: [Select]

(defun _Is64Bit ( )

    (setq *Is64Bit* (wcmatch (getvar "platform") "*64*"))   
   
    (defun _Is64Bit ( ) *Is64Bit*)
   
    *Is64Bit*

)

(defun _ObjectIDToObject ( document objectid / object )

    (if (zerop objectid)
        document
        (progn
            (vl-catch-all-apply
                (function
                    (lambda ( )
                        (setq object
                            (vlax-invoke
                                document
                                (if (_Is64Bit) 'objectidtoobject32 'objectidtoobject)
                                objectid
                            )
                        )   
                    )
                )
            )   
            object
        )   
    )   
)
fwiw ...

Title: Re: Ellipses to polylines
Post by: Andrea on November 18, 2011, 12:09:29 PM

Thank you for the info..

But i'm not sure to understand the difference between both..
vla-objectidtoobject seem to work great in 64 and 32 bits.. case.

Code: [Select]

(vla-objectidtoobject
   (vla-get-activedocument
     (vlax-get-acad-object)
   )
   (vla-get-ownerid
     (vlax-ename->vla-object
       (car (entsel))
       )
     )
)
Thanks.

Title: Re: Ellipses to polylines
Post by: MP on November 18, 2011, 12:11:26 PM

I mentioned it because vla-objectidtoobject was crashing for me under Windows 7 and AutoCAD 2012.

Title: Re: Ellipses to polylines
Post by: Andrea on November 18, 2011, 12:43:07 PM

Hummm...i've tested on 2011 and 2012 win7 64 bits..

?

But thanks for the info.

Title: Re: Ellipses to polylines
Post by: alanjt on November 18, 2011, 05:44:47 PM

Quote from: MP on November 18, 2011, 11:48:08 AM

Code: [Select]

(defun _Is64Bit ( )

    (setq *Is64Bit* (wcmatch (getvar "platform") "*64*"))   
   
    (defun _Is64Bit ( ) *Is64Bit*)
   
    *Is64Bit*

)


(http://www.theswamp.org/lilly_pond/alanjt/bow_notWorthy.gif) just wow

Title: Re: Ellipses to polylines
Post by: MP on November 18, 2011, 08:03:58 PM

Quote from: alanjt on November 18, 2011, 05:44:47 PM

(http://www.theswamp.org/lilly_pond/alanjt/bow_notWorthy.gif) just wow

(http://www.theswamp.org/screens/mp/sarcasm.png) ?

Title: Re: Ellipses to polylines
Post by: Kerry on November 18, 2011, 08:08:23 PM

Probably more awe at the succinctness.

Title: Re: Ellipses to polylines
Post by: alanjt on November 18, 2011, 08:32:57 PM

Quote from: MP on November 18, 2011, 08:03:58 PM

Quote from: alanjt on November 18, 2011, 05:44:47 PM

(http://www.theswamp.org/lilly_pond/alanjt/bow_notWorthy.gif) just wow

(http://www.theswamp.org/screens/mp/sarcasm.png) ?

not at all
your code never ceases to amaze.

Title: Re: Ellipses to polylines
Post by: MP on November 18, 2011, 08:36:14 PM

Quote from: alanjt on November 18, 2011, 08:32:57 PM

not at all
your code never ceases to amaze.

Sorry for my misinterpretation. Thank you but I can't take credit for the defun redef technique, I believe Jon Fleming or Tony Tanzillo first did it, probably 437 years ago.

Title: Re: Ellipses to polylines
Post by: Kerry on November 18, 2011, 08:38:33 PM

Quote from: MP on November 18, 2011, 08:36:14 PM

< ... > probably 437 years ago.

I remember that day, it was a Tuesday.

Title: Re: Ellipses to polylines
Post by: alanjt on November 18, 2011, 09:14:17 PM

Quote from: MP on November 18, 2011, 08:36:14 PM

Quote from: alanjt on November 18, 2011, 08:32:57 PM

not at all
your code never ceases to amaze.

Sorry for my misinterpretation. Thank you but I can't take credit for the defun redef technique, I believe Jon Fleming or Tony Tanzillo first did it, probably 437 years ago.

:) Well, it's impressive and I thank you regardless.

I borrowed this idea from gile a few years back (slightly modified from his original version that set commands for each view):

Code: [Select]

(foreach radius '(0 1 2 3 4 5 6 7 8 9)
  ;; Fillet with radius (0-9)
  (eval (list 'defun
              (if (zerop radius)
                'c:FF
                (read (strcat "c:F" (itoa radius)))
              )
              nil
              (list 'setvar "filletrad" radius)
              (list 'princ (strcat "\nFillet radius set to: " (rtos radius)))
              (list 'command "_.fillet")
              '(princ)
        )
  )
)

Title: Re: Ellipses to polylines
Post by: MP on November 18, 2011, 09:30:29 PM

Quote from: alanjt on November 18, 2011, 09:14:17 PM

Well, it's impressive and I thank you regardless.

I borrowed this idea from gile a few years back ...

You're welcome. Gile's stuff is always top shelf. Many variants (http://www.theswamp.org/index.php?topic=35014.msg402274#msg402274) of that technique abound, here's another from awhile back ...

Code: [Select]

...
(eval
    (cons 'defun
        (list 'GetAlignment '( value )
            (cons 'cdr
                (list
                    (list 'assoc 'value
                        (list 'quote lst)
                    )
                )
            )   
        )
    )
)
:)

Title: Re: Ellipses to polylines
Post by: alanjt on November 18, 2011, 09:39:05 PM

Quote from: MP on November 18, 2011, 09:30:29 PM

Quote from: alanjt on November 18, 2011, 09:14:17 PM

Well, it's impressive and I thank you regardless.

I borrowed this idea from gile a few years back ...

You're welcome. Gile's stuff is always top shelf. Many variants (http://www.theswamp.org/index.php?topic=35014.msg402274#msg402274) of that technique abound, here's another from awhile back ...

HaHa, I remember that thread. Learned quite a bit that day. :)

Title: Re: Ellipses to polylines
Post by: MP on November 18, 2011, 09:59:38 PM

Quote from: alanjt on November 18, 2011, 09:39:05 PM

HaHa, I remember that thread. Learned quite a bit that day. :)

some threads are really fun to start :)

Title: Re: Ellipses to polylines
Post by: Lee Mac on November 19, 2011, 07:46:04 AM

Another example for the mix (http://www.theswamp.org/index.php?topic=37553.0)  :-)

Title: Re: Ellipses to polylines
Post by: gile on November 19, 2011, 02:39:06 PM

Hi,

About ObjectId and 64 bits platforms, from what I read somewhere (I don't remember where) the ObjectId32, OwnerId32 and ObjectIdToObject32 properties and method are only requiered for VBA on 64 bits platforms. By my side I never noticed problems using the 'old' unsuffixed ones with LISP on acad 2010, 2011 and 2012 64 bits (but I do not use as LISP routines as I did).

Another thing, using the "platform" sysvar evaluates the Windows platform version, not the AutoCAD version. On a windows 7 64 bits, I have an AutoCAD 2007 32 bits installed and (getvar 'platform) returns "Microsoft Windows NT Version 6.1 (x64)".
To evaluate the AutoCAD paltform version I'd rather evaluate if ObjectId32 is available :

Code: [Select]

(defun gc:IsAcad64   ()
  (vlax-property-available-p
    (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    'ObjectId32
  )
)

Title: Re: Ellipses to polylines
Post by: MP on November 19, 2011, 03:01:57 PM

Great info. Maybe my system needed it because I installed vba on on it. Have to do some investigating. Nonetheless, your info is appreciated, especially the heads up about using the platform sysvar, thank you very much Giles.

And Lee: I never saw your GrText suite before, awesome work.

Title: Re: Ellipses to polylines
Post by: Lee Mac on November 20, 2011, 07:29:51 AM

Quote from: MP on November 19, 2011, 03:01:57 PM

And Lee: I never saw your GrText suite before, awesome work.

Cheers Michael  :-)

Title: Re: Ellipses to polylines
Post by: VVA on November 22, 2011, 12:58:42 AM

Another version
;;; http://forum.dwg.ru/showthread.php?t=31568

Code: [Select]

(defun Acad64Bit-version ()
  (vl-load-com)
  (> (strlen (vl-prin1-to-string (vlax-get-acad-object))) 40)
)