Real Numbers Floating Precision

I am confused as to how lisp handles the floating precision of a point.

I am trying to use the IntersectWith method and am getting some funky results. I have determined that it is a result of the precision of the point.

I have as follows:

 
(setq pointlist  (vlax-safearray->list (vlax-variant-value (vlax-invoke-method line-obj 'IntersectWith polyline-obj acExtendNone))))

and it returns: (476472.0 215324.0 0.0)

Ok... so it is not showing me all of the decimal places. No big deal, right?

Next I use:

(setq x (nth 0 poinlist))

i then inspect x and i get 476472.0

There must be something that I am missing or not understanding. Any help would be greatly appreciated! I am expecting 476472.96706517 or something of the sorts.

regards,

Hippe013

As a quick one, you could avoid the variant by using the undocumented vlax-invoke function hence:

(setq lst (vlax-invoke line-obj 'IntersectWith polyline acExtendNone))

To display more places, perhaps use rtos:

(rtos (car lst) 2 15)

Hey Lee, Thanks for the heads up on the code as follows:

 
(setq lst (vlax-invoke line-obj 'IntersectWith polyline acExtendNone))

Variants can be a headache at times.

As it turns out the problem I was having turned out to be just a minor typo.

I would like to share what I was working on, though bear in mind I am still in the stages of debugging and will also need to add error traps to make it dummy proof.

The following code drapes a 3dpolyline over a series of elevated polylines (contours) along a given line. Pretty much it samples the polylines. Feel free to let me know what you think.

 
;Drapes a 3dpolyline over polylines along a selected line. 
(vl-load-com)
(defun c:sample-pl ( / li *ModSpc *ActDoc *Acad lobj p1 p2 ss sslen i plobj pnts n li pntli finli var)
 (setq li nil)
 (setq *ModSpc (vlax-get-property (setq *ActDoc (vlax-get-property (setq *acad (vlax-get-acad-object)) 'ActiveDocument)) 'ModelSpace))
 (setq lobj (vlax-ename->vla-object (car (entsel "\nSelect Line Object: "))))
 (setq p1 (vlax-safearray->list (vlax-variant-value (vlax-get-property lobj 'StartPoint))))
 (setq p2 (vlax-safearray->list (vlax-variant-value (vlax-get-property lobj 'EndPoint))))
 (setq ss (ssget "f" (list p1 p2) '(( 0 . "LWPOLYLINE"))))
 (setq sslen (sslength ss))
 (setq i 0)
 (repeat sslen
   (setq plobj (vlax-ename->vla-object (ssname ss i)))
   (setq el (vlax-get-property plobj 'Elevation))
   (vlax-put-property plobj 'Elevation 0)
   (setq pnts (vlax-invoke lobj 'IntersectWith plobj acExtendNone))
   (vlax-put-property plobj 'Elevation el)
   (vlax-release-object plobj)
   (setq n 0)
   (repeat (/ (length pnts) 3)
     (setq li (append li (list (nth (+ n 0) pnts))))
     (setq li (append li (list (nth (+ n 1) pnts))))
     (setq li (append li (list el)))
     (drxc (list (nth (+ n 0) pnts) (nth (+ n 1) pnts) el) 2)
     (setq n (+ n 3))
     )
   (setq i (1+ i))
   )
 (setq n 0)
 (setq pntli nil)
 (repeat (/ (length li) 3)
   (setq pntli (append pntli (list (cons (distance (list (nth (+ n 0) li) (nth (+ n 1) li)) (list (nth 0 p1) (nth 1 p1))) (list (list (nth (+ n 0) li) (nth (+ n 1) li)(nth (+ n 2) li)))))))
   (setq n (+ n 3))
   )
 (setq pntli (vl-sort pntli (function (lambda (d1 d2) (< (car d1) (car d2))))))
 (setq n 0)
 (setq finli nil)
 (repeat (length pntli)
   (setq finli (append finli (cadr (nth n pntli))))
   (setq n (1+ n))
 )
 (setq var (pl->var finli))
 (setq 3dobj2 (vlax-invoke-method *ModSpc 'Add3DPoly var))
 (vlax-put-property 3dobj2 'Color 1)
 (vlax-release-object 3dobj2)
 )

;Given Pointlist returns pointlist in variant form
(defun PL->VAR ( pl / pl ub sa var)
 (setq ub (- (length li) 1))
 (setq sa (vlax-make-safearray vlax-vbdouble (cons 0 ub)))
 (setq var (vlax-make-variant (setq sa (vlax-safearray-fill sa pl))))
 )
;Graphically draws an "X" at given point and color. Example: (drxc '( 1 2 3) 1) draws x at x=1 y=2 z=3 in the color red    
(defun drxc (ctr color / vs xs xs2 cor1 cor2 cor3 cor4 ctr color)
 (setq vs (getvar "viewsize"))
 (setq xs (/ vs 20))
 (setq xs2 (/ xs 2))
 (setq cor1 (polar ctr (* pi 0.25) xs2))
 (setq cor2 (polar ctr (* pi 0.75) xs2))
 (setq cor3 (polar ctr (* pi 1.25) xs2))
 (setq cor4 (polar ctr (* pi 1.75) xs2))
 (grdraw ctr cor1 color 0)
 (grdraw ctr cor2 color 0)
 (grdraw ctr cor3 color 0)
 (grdraw ctr cor4 color 0)
 )

I really like the idea

I hope you don't mind, I would be inclined to code it like this - just offering it as a suggestion.

(defun c:LWPolySample ( / _dxf doc spc lobj p1 ss ev tmp lst ) (vl-load-com)
 ;; © Lee Mac 2010

 (defun _dxf ( code entity ) (cdr (assoc code (entget entity))))

 (LM:ActiveSpace 'doc 'spc)
 
 (if
   (and (setq lobj (car (entsel "\nSelect Line: "))) (eq "LINE" (_dxf 0 lobj))
     (ssget "_F"
       (list (setq p1 (_dxf 10 lobj)) (_dxf 11 lobj)) '((0 . "LWPOLYLINE"))
     )
   )
   (progn (setq lobj (vlax-ename->vla-object lobj))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))

       (setq ev (vla-get-Elevation obj))
       (vla-put-Elevation obj 0.0)

       (setq lst
         (cons
           (mapcar
             (function
               (lambda ( x ) (list (car x) (cadr x) ev))
             )
             (GroupByNum (vlax-invoke obj 'IntersectWith lobj acExtendNone) 3)
           )
           lst
         )
       )
       (vla-put-Elevation obj ev)
     )
     (vla-delete ss)

     (vla-put-Color
       (vlax-invoke spc 'Add3DPoly
         (apply 'append
           (vl-sort (apply 'append lst)
            '(lambda ( a b )
               (< (distance p1 (list (car a) (cadr a))) (distance p1 (list (car b) (cadr b))))
             )
           )
         )
       )
       1
     )
   )
 )

 (princ)
)

(defun GroupByNum ( l n / r)
 ;; © Lee Mac 2010
 (setq r (list (car l)))
 
 (if l
   (cons
     (reverse
       (repeat (1- n) (setq l (cdr l) r (cons (car l) r)))
     )
     (GroupByNum (cdr l) n)
   )
 )
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol (other than *doc)                    ;;
;;  *spc - quoted symbol (other than *spc)                    ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (vlax-get-property
     (set *doc
       (vla-get-ActiveDocument
         (vlax-get-acad-object)
       )
     )
     (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)
   )
 )
)

Lee

I like it! Cleaner, more clever & possibly faster, but most of all it sheds light on new items that I may have never used such as:

How you obtain your selection set.

Deleting the Selection set.

Iterating through a selection set.

And most of all how your code is well nested where my code is a step by step through out the process.

I suppose one question I do have for you is releasing an object. When is important to be using (vlax-release-object obj) and when can you ignore it?

And one minor item I do like in my code is the use of drxc to display where the points are being drawn. If you were to add that feature in your code where would you place it?

Thank you for your input,

regards and a Happy New Year

hippe013

I like it! Cleaner, more clever & possibly faster, but most of all it sheds light on new items that I may have never used such as:

 

How you obtain your selection set.

 

Deleting the Selection set.

 

Iterating through a selection set.

I use that method of dealing with the SelectionSet as I know I shall be dealing with VLA-Objects, and hence retrieving and iterating through the ActiveSelectionSet from the SelectionSets collection is a faster method than converting every entity into a VLA-Object.

And most of all how your code is well nested where my code is a step by step through out the process.

You can greatly increase the program efficiency if you minimise the number of times you have to iterate through the information (only once if possible!). So in this respect, I would endeavour to accomplish many operations in a single loop, instead of many loops for each operation.

I suppose one question I do have for you is releasing an object. When is important to be using (vlax-release-object obj) and when can you ignore it?

There are mixed opinions over this - my opinion is that one should only have to release an object that is created outside of the AutoCAD Object Model (such as the FSO, WSH etc), AutoCAD will take care of those objects falling within its scope.

More discussions here.

And one minor item I do like in my code is the use of drxc to display where the points are being drawn. If you were to add that feature in your code where would you place it?

I might use something like this:

(defun c:LWPolySample ( / _dxf doc spc lobj p1 ss ev tmp lst ) (vl-load-com)
 ;; © Lee Mac 2010

 (defun _dxf ( code entity ) (cdr (assoc code (entget entity))))

 (LM:ActiveSpace 'doc 'spc)
 
 (if
   (and (setq lobj (car (entsel "\nSelect Line: "))) (eq "LINE" (_dxf 0 lobj))
     (ssget "_F"
       (list (setq p1 (_dxf 10 lobj)) (_dxf 11 lobj)) '((0 . "LWPOLYLINE"))
     )
   )
   (progn (setq lobj (vlax-ename->vla-object lobj))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))

       (setq ev (vla-get-Elevation obj))
       (vla-put-Elevation obj 0.0)

       (setq lst
         (cons
           (mapcar
             (function
               (lambda ( x ) (LM:GrX (list (car x) (cadr x) ev) 7 3))
             )
             (GroupByNum (vlax-invoke obj 'IntersectWith lobj acExtendNone) 3)
           )
           lst
         )
       )
       (vla-put-Elevation obj ev)
     )
     (vla-delete ss)

     (vla-put-Color
       (vlax-invoke spc 'Add3DPoly
         (apply 'append
           (vl-sort (apply 'append lst)
            '(lambda ( a b )
               (< (distance p1 (list (car a) (cadr a))) (distance p1 (list (car b) (cadr b))))
             )
           )
         )
       )
       1
     )
   )
 )

 (princ)
)

(defun GroupByNum ( l n / r)
 ;; © Lee Mac 2010
 (setq r (list (car l)))
 
 (if l
   (cons
     (reverse
       (repeat (1- n) (setq l (cdr l) r (cons (car l) r)))
     )
     (GroupByNum (cdr l) n)
   )
 )
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol (other than *doc)                    ;;
;;  *spc - quoted symbol (other than *spc)                    ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (vlax-get-property
     (set *doc
       (vla-get-ActiveDocument
         (vlax-get-acad-object)
       )
     )
     (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)
   )
 )
)

;;-----------------------=={ grX }==--------------------------;;
;;                                                            ;;
;;  Displays an 'X' in at the point specified, in the colour  ;;
;;  specified                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  p - point at which to display 'X' (in WCS)                ;;
;;  s - size of point (in pixels)                             ;;
;;  c - colour of point (ACI Colour)                          ;;
;;------------------------------------------------------------;;
;;  Returns:  The WCS point supplied                          ;;
;;------------------------------------------------------------;;

(defun LM:grX ( p s c / -s l r q )
 ;; © Lee Mac 2010

 (setq -s (- s) l
    (list c
      (list -s     -s)  (list s s)
      (list -s (1+ -s)) (list (1- s) s)
      (list (1+ -s) -s) (list s (1- s))
      
      (list -s s)       (list s -s)
      (list -s (1- s))  (list (1- s) -s)
      (list (1+ -s) s)  (list s (1+ -s))
    )
 )

 (setq r (/ (getvar 'VIEWSIZE) (cadr (getvar 'SCREENSIZE))) q (trans p 0 3))

 (grvecs l
   (list
     (list r  0. 0. (car  q))
     (list 0. r  0. (cadr q))
     (list 0. 0. r  0.)
     (list 0. 0. 0. 1.)
   )
 )
 p
)

Thank you for your input,

regards and a Happy New Year

You're very welcome, and a Happy New Year to you too!