1e+99 problem

3wood · ‎06-19-2013

Good morning,

There are two lines in attached drawing. It seems FLATTEN doesn't work on them. How can I flatten them with lisp code?

Thanks a lot for your great help.

CADaSchtroumpf · ‎06-20-2013

Good morning,

I write this code (for the linear object), it seems to work!
Glad if could help

(defun l-coor2l-pt (lst flag / )
	(if lst
		(cons
			(list
				(car lst)
				(cadr lst)
				(if flag
					(+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst))
					(if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
				)
			)
			(l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
		)
	)
)
(vl-load-com)
(defun c:my_project ( / jspl nbr n AcDoc Space UCS save_ucs WCS ent_name indx l_blg l_pt ename id_obj pl_typ index nw_pl)
 (setq
	jspl
	 (ssget
		'((-4 . "<OR")
		 (-4 . "<AND")
			(0 . "POLYLINE")
			(-4 . "<NOT")
			 (-4 . "&") (70 . 112)
			(-4 . "NOT>")
		 (-4 . "AND>")
		 (0 . "LWPOLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE,POINT")
		(-4 . "OR>"))
	 )
	nbr -1
	n 0
 )
 (cond
	(jspl
		(setq
			AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
			Space
			(if (eq (getvar "CVPORT") 1)
				(vla-get-PaperSpace AcDoc)
				(vla-get-ModelSpace AcDoc)
			)
			UCS (vla-get-UserCoordinateSystems AcDoc)
			save_ucs
			(vla-add UCS
				(vlax-3d-point '(0.0 0.0 0.0))
				(vlax-3d-point (getvar "UCSXDIR"))
				(vlax-3d-point (getvar "UCSYDIR"))
				"CURRENT_UCS"
			)
		)
	 (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG")))
	 (vla-StartUndoMark AcDoc)
	 (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS"))
	 (vla-put-activeUCS AcDoc WCS)
	 (repeat (sslength jspl)
		(setq
		 ent_name (ssname jspl (setq nbr (1+ nbr)))
		 indx -1
		 l_blg nil
		 l_pt nil
		 ename (vlax-ename->vla-object ent_name)
		 id_obj (vla-get-ObjectName ename)
		)
		(cond
		 ((member id_obj '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline"))
			(setq pl_typ (if (vlax-property-available-p ename 'Type) (vlax-get ename 'Type)))
			(if (member id_obj '("AcDbPolyline" "AcDb2dPolyline"))
			 (if (not (equal (vlax-get ename 'Normal) '(0.0 0.0 1.0) 1E-13))
				(progn
				 (repeat (fix (vlax-curve-getEndParam ename))
					(setq l_pt (cons (vlax-curve-GetPointAtParam ename (setq indx (1+ indx))) l_pt) index (float indx))
					(if (or (eq pl_typ 1) (if (< pl_typ 3) (not (zerop (vla-GetBulge ename indx)))))
					 (while (eq indx (fix (+ 0.01 index)))
						(setq l_pt (cons (vlax-curve-GetPointAtParam ename (setq index (+ 0.01 index))) l_pt))
					 )
					)
				 )
				 (setq l_pt (cons (vlax-curve-getEndPoint ename) l_pt))
				)
				(setq l_pt
				 (mapcar
					'(lambda (x)
					 (trans
						(list
						 (car x)
						 (cadr x)
						 (+
							(if (eq id_obj "AcDbPolyline") (caddr x) 0.0)
							(if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
						 )
						)
						ent_name
						0
					 )
					)
					(l-coor2l-pt (vlax-get ename 'Coordinates) (eq id_obj "AcDb2dPolyline"))
				 )
				)
			 )
			 (setq l_pt (l-coor2l-pt (vlax-get ename 'Coordinates) T))
			)
			(if (eq (vla-get-ObjectName ename) "AcDbPolyline")
			 (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt)))))
			 (setq nw_pl (vlax-invoke Space 'AddPolyline (apply 'append l_pt)))
			)
			(vla-put-Normal nw_pl (vlax-3d-point '(0 0 1)))
			(if (vlax-property-available-p ename 'Type)
			 (progn
				(setq pl_typ
				 (if (eq (vla-get-ObjectName ename) "AcDb3dPolyline")
					(if (zerop (vlax-get ename 'Type)) (vlax-get ename 'Type) (1+ (vlax-get ename 'Type)))
					(vlax-get ename 'Type)
				 )
				)
				(if (and (vlax-property-available-p ename 'Normal) (not (equal (vlax-get ename 'Normal) '(0.0 0.0 1.0) 1E-13)) (eq pl_typ 1))
				 (vla-put-Type nw_pl 0)
				 (vla-put-Type nw_pl pl_typ)
				)
			 )
			 (if (and (vlax-property-available-p ename 'Normal) (equal (vlax-get ename 'Normal) '(0 0 1) 1E-13))
				(progn
				 (repeat (length l_pt) (setq l_blg (cons (vla-GetBulge ename (setq indx (1+ indx))) l_blg)))
				 (foreach el l_blg (vla-SetBulge nw_pl indx el) (setq indx (1- indx)))
				)
			 )
			)
			(vla-put-Closed nw_pl (vlax-get ename 'Closed))
		 )
		 ((member id_obj '("AcDbEllipse" "AcDbCircle" "AcDbArc"))
			(if (not (equal (vlax-get ename 'Normal) '(0.0 0.0 1.0) 1E-13))
			 (progn
				(setq
				 index (vlax-curve-getStartParam ename)
				 l_pt (list (vlax-curve-GetPointAtParam ename index))
				)
				(while (< (setq index (+ 0.01 index)) (vlax-curve-getEndParam ename))
				 (setq l_pt (cons (vlax-curve-GetPointAtParam ename index) l_pt))
				)
				(setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt)))))
			 )
			 (cond
				((eq id_obj "AcDbEllipse")
				 (setq
					l_pt (vlax-get ename 'Center)
					nw_pl
					(vlax-invoke Space 'AddEllipse
					 (list (car l_pt) (cadr l_pt) 0.0)
					 (list (car (vlax-get ename 'MajorAxis)) (cadr (vlax-get ename 'MajorAxis)) 0.0)
					 (* (caddr (vlax-get ename 'Normal)) (vlax-get ename 'RadiusRatio))
					)
				 )
				 (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1)))
				 (vla-put-StartAngle nw_pl (vlax-get ename 'StartAngle))
				 (vla-put-StartParameter nw_pl (vlax-get ename 'StartParameter))
				 (vla-put-EndParameter nw_pl (vlax-get ename 'EndParameter))
				)
				((or (eq id_obj "AcDbArc") (eq id_obj "AcDbCircle"))
				 (setq
					l_pt (vlax-get ename 'Center)
					nw_pl
					(if (eq id_obj "AcDbArc")
					 (vlax-invoke Space 'AddArc (list (car l_pt) (cadr l_pt) 0.0) (vlax-get ename 'Radius) (vlax-get ename 'StartAngle) (vlax-get ename 'EndAngle))
					 (vlax-invoke Space 'AddCircle (list (car l_pt) (cadr l_pt) 0.0) (vlax-get ename 'Radius))
					)
				 )
				 (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1)))
				)
			 )
			)
		 )
		 ((eq id_obj "AcDbSpline")
			(if
			 (or
				(zerop (vlax-get ename 'IsPlanar))
				(and
				 (not (zerop (vlax-get ename 'IsPlanar)))
				 (not (equal (cdr (assoc 210 (entget ent_name))) '(0.0 0.0 1.0) 1E-13))
				)
			 )
			 (progn
				(setq
				 index (vlax-curve-getStartParam ename)
				 l_pt (list (vlax-curve-GetPointAtParam ename index))
				)
				(while (< (setq index (+ 10.0 index)) (vlax-curve-getEndParam ename))
				 (setq l_pt (cons (vlax-curve-GetPointAtParam ename index) l_pt))
				)
				(setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt)))))
			 )
			 (progn
				(setq
				 l_pt (l-coor2l-pt (if (zerop (vlax-get ename 'NumberOfFitPoints)) (cdddr (reverse (cdddr (reverse (vlax-get ename 'ControlPoints))))) (vlax-get ename 'FitPoints)) T)
				 nw_pl
				 (vlax-invoke Space
					'AddSpline
					(apply 'append (mapcar '(lambda (x y) (list x y 0.0)) (mapcar 'car l_pt) (mapcar 'cadr l_pt)))
					(list (car (vlax-curve-getFirstDeriv ename 0)) (cadr (vlax-curve-getFirstDeriv ename 0)) 0.0)
					(list (car (vlax-curve-getFirstDeriv ename (vlax-curve-getEndParam ename))) (cadr (vlax-curve-getFirstDeriv ename (vlax-curve-getEndParam ename))) 0.0)
				 )
				 l_pt (l-coor2l-pt (vlax-get ename 'ControlPoints) T)
				)
				(vla-put-ControlPoints nw_pl 
				 (vlax-make-variant
					(vlax-safearray-fill
					 (vlax-make-safearray
						vlax-vbDouble
						(cons 0 (1- (* (length l_pt) 3)))
					 )
					 (apply 'append (mapcar '(lambda (x y) (list x y 0.0)) (mapcar 'car l_pt) (mapcar 'cadr l_pt)))
					)
				 )
				)
			 )
			)
		 )
		 ((eq id_obj "AcDbLine")
			(setq nw_pl
			 (vlax-invoke Space
				'AddLine
				(list (car (vlax-get ename 'StartPoint)) (cadr (vlax-get ename 'StartPoint)) 0.0)
				(list (car (vlax-get ename 'EndPoint)) (cadr (vlax-get ename 'EndPoint)) 0.0)
			 )
			)
			(vla-put-Normal nw_pl (vlax-3d-point '(0 0 1)))
		 )
		 ((eq id_obj "AcDbPoint")
			(setq nw_pl
			 (vlax-invoke Space
				'AddPoint
				(list (car (vlax-get ename 'Coordinates)) (cadr (vlax-get ename 'Coordinates)) 0.0)
			 )
			)
			(vla-put-Normal nw_pl (vlax-3d-point '(0 0 1)))
		 )
		)
		(vla-put-Layer nw_pl (vla-get-Layer ename))
		(vla-delete ename)
	 )
	 (and save_ucs (vla-put-activeUCS AcDoc save_ucs))
	 (and WCS (vla-delete WCS) (setq WCS nil))
	 (vla-EndUndoMark AcDoc)
	 (princ
		(strcat
		 "\n"
		 (itoa (sslength jspl))
		 " projected entities. ENDING!"
		)
	 )
	)
	(T (princ "\nNo chosen correspondent entities!"))
 )
 (prin1)
)

3wood · ‎06-20-2013

Many thanks.

It works well on the sample drawing.

But it encounter an error in another drawing - ; error: invalid point: (61370.0 18740.0 2.0e+099)

It looks this time the Z value goes crazy high!

I need some time to digest the code.

I have checked the code of FLATTEN, it explodes the polyline to lines and arcs, then reconstruct the polyline after changing the Z value of segments. It is also a good idea.

alanjt_ · ‎06-20-2013

(defun c:Flat (/ ss i obj)
  ;; Flatten selected objects
  ;; Alan J. Thompson, 11.30.11
  (if (setq ss (ssget "_:L" '((0 . "~AECC*"))))
    (repeat (setq i (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
      (foreach point '((0. 0. 1e99) (0. 0. -1e99)) (vlax-invoke obj 'move '(0. 0. 0.) point))
    )
  )
  (princ)
)

3wood · ‎06-20-2013

Thanks Alan.

It works great on the vertical line in the sample drawing, but doesn't work on the horizontal one.

alanjt_ · ‎06-20-2013

@3wood wrote:
Thanks Alan.
It works great on the vertical line in the sample drawing, but doesn't work on the horizontal one.

Ahh, didn't even notice the sample drawing. Will have to look at later. I am most curious. The method I posted has worked against every thing I've ever thrown at it.

CADaSchtroumpf · ‎06-20-2013

3wood a écrit :

But it encounter an error in another drawing - ; error: invalid point: (61370.0 18740.0 2.0e+099)

If you want?
Can you change, in loop (repeat

		(setq
		 ent_name (ssname jspl (setq nbr (1+ nbr)))
		 indx -1
		 l_blg nil
		 l_pt nil
		 ename (vlax-ename->vla-object ent_name)
		 id_obj (vla-get-ObjectName ename)
		)

to

		(setq
		 ent_name (ssname jspl (setq nbr (1+ nbr)))
		 toto ent_name
		 indx -1
		 l_blg nil
		 l_pt nil
		 ename (vlax-ename->vla-object ent_name)
		 id_obj (vla-get-ObjectName ename)
		)

load and run lisp code again, and post here the return of
(entget toto) after the lisp fail.

With this, I can analyzing the problem.

3wood · ‎06-20-2013

Here is the return, thanks a lot for the help.

((-1 . <Entity name: 7fffe942710>) (0 . "LWPOLYLINE") (330 . <Entity name: 7fffebbc9f0>) (5 . "D0139") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "STSO-TREN-WALL-HIDD-N") (48 . 8.0) (100 . "AcDbPolyline") (90 . 2) (70 . 0) (43 . 0.0) (38 . 1.0e+099) (39 . 0.0) (10 61370.0 18740.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 47525.0 18740.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (210 0.0 0.0 1.0))

I can post the drawing if necessary.

smaher12 · ‎06-20-2013

Try this one:

(defun c:chgelev ()
        (graphscr)
        (setq elev (getreal "Enter new object elevation: "))
        (setq ss (ssget))
        (setq i 0)
        (while (setq ent (ssname ss i))
                (setq entlist (entget ent))
                (setq entlist (change_point entlist 10 elev))
                (cond   ((or    (eq (cdr (assoc 0 entlist)) "3DFACE")
                                (eq (cdr (assoc 0 entlist)) "SOLID"))
                                (setq entlist (change_point entlist 11 elev))
                                (setq entlist (change_point entlist 12 elev))
                                (setq entlist (change_point entlist 13 elev))
                        )
                        ((eq (cdr (assoc 0 entlist)) "LINE")
                                (setq entlist (change_point entlist 11 elev))
                        )
                        ((eq (cdr (assoc 0 entlist)) "POLYLINE")
                                  (cond ((eq 8 (boole 1 (cdr (assoc 70 entlist)) 8))
                                                (while  (eq "VERTEX" (cdr (assoc 0 (setq entlist (entget (setq ent (entnext ent)))))))
                                                                (setq entlist (change_point entlist 10 elev))
                                                        
                                                )
                                        )
                                  )
                        )
                )
                (setq i (1+ i))
        )
        (command "regenall")
)

(defun change_point (elist point el)
        (setq xyz (assoc point elist))
        (setq elist 
                (subst 
                        (list point (nth 1 xyz) (nth 2 xyz) el) 
                        (assoc point elist)
                        elist
                )
        )
        (entmod elist)
        (setq elist elist)
)

CADaSchtroumpf · ‎06-20-2013

Perhaps an error of sign, I think...

        (setq l_pt
         (mapcar
          '(lambda (x)
           (trans
            (list
             (car x)
             (cadr x)
             (+
              (if (eq id_obj "AcDbPolyline") (caddr x) 0.0)
              (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
             )
            )
            ent_name
            0
           )
          )
          (l-coor2l-pt (vlax-get ename 'Coordinates) (eq id_obj "AcDb2dPolyline"))
         )
        )

must be

        (setq l_pt
         (mapcar
          '(lambda (x)
           (trans
            (list
             (car x)
             (cadr x)
             (-
              (if (eq id_obj "AcDbPolyline") (caddr x) 0.0)
              (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
             )
            )
            ent_name
            0
           )
          )
          (l-coor2l-pt (vlax-get ename 'Coordinates) (eq id_obj "AcDb2dPolyline"))
         )
        )

Thank for the return

3wood · ‎06-20-2013

smaher12 wrote:

Try this one:
...

Thanks.

But this one doesn't work at all on the sample file.

3wood · ‎06-20-2013

@CADaSchtroumpf wrote:
Perhaps an error of sign, I think...
...
must be
...
Thank for the return

This one works perfectly! Thanks for the help.

1e+99 problem

1e+99 problem

Forums Links

Post to forums