Topic: Ellipses to polylines

[gile]

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

[cjw]

Very nice code,gile.

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


[gile]

Thanks cjw

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

[Hedgehog]

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

[gile]

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

Not prior A2010

[Hedgehog]

... oops 

[gile]

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.

[cjw]

Thanks cjw

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

I am sorry!

Thanks.

[luiscarneirorm]

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  .
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.

[luiscarneirorm]

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???

[gile]

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.

[luiscarneirorm]

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.

[gile]

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...

[luiscarneirorm]

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???

[gile]

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.

[luiscarneirorm]

it's in the 11# post 


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??

[gile]

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

[kraz]

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

[luiscarneirorm]

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 ...

[Andrea]

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..
 

[gile]

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

[Andrea]

I'm not as skilled..   :blank:

thanks !

[MP]

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 ...

[Andrea]

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.

[MP]

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

[Andrea]

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

?

But thanks for the info.

[alanjt]

Code: [Select]

(defun _Is64Bit ( )

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

)


just wow

[MP]

just wow

?

[Kerry]

Probably more awe at the succinctness.

[alanjt]

just wow

?

not at all
your code never ceases to amaze.

[MP]

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.

[Kerry]

< ... > probably 437 years ago.

I remember that day, it was a Tuesday.

[alanjt]

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

[MP]

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

[alanjt]

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 of that technique abound, here's another from awhile back ...

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

[MP]

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

some threads are really fun to start

[Lee Mac]

Another example for the mix 

[gile]

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

[MP]

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.

[Lee Mac]

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

Cheers Michael 

[VVA]

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