LISP to select lines and text according to "Z" values

[Nikon]

If all the primitives (TEXT,MTEXT,INSERT,LINE,LWP,Circle,Mleader,Dimension) are perceived as objects, 
then you can use this code:
 

;; Set coordinates of objects (TEXT,MTEXT,INSERT,LINE,LWP,Circle,Mleader,Dimension) Z in 0
(defun zeroz-in-list (lst /)
  (cond
    ;; The list of coordinates-vertex
    ((and (listp lst)
          (= (length lst) 2)
          (numberp (car lst))
          (numberp (cadr lst)))
      ;; if only XY - expanding to XYZ
      (list (car lst) (cadr lst) 0.0)
    )
    ((and (listp lst)
          (= (length lst) 3)
          (numberp (car lst))
          (numberp (cadr lst))
          (numberp (caddr lst)))
     ;; if already XYZ -  just do Z=0.0
     (list (car lst) (cadr lst) 0.0)
    )
    ;; If it's a large list, it's probably nested
    ((listp lst)
     (mapcar 'zeroz-in-list lst)
    )
    (t lst)
  )
)

(defun c:ObjZ0 (/ ss n e el newel)
  (prompt "
Select objects (all types, including polylines, mleader, dimension): ")
  (if (setq ss (ssget))
    (progn
      (setq n 0)
      (while (< n (sslength ss))
        (setq e (ssname ss n)
              el (entget e)
              newel nil
        )
        (foreach pair el
          (cond
            ;; height LWPOLYLINE (code 38)
            ((and (= (car pair) 38) (numberp (cdr pair)))
             (setq newel (cons (cons 38 0.0) newel))
            )
            ;;Point codes (for example, 10, 11, 12...), etc.
            ((and (numberp (car pair))
                  (not (= (car pair) 210))) ; Don't touch the normal
             (if (listp (cdr pair))
                 (setq newel (cons (cons (car pair) (zeroz-in-list (cdr pair))) newel))
                 (setq newel (cons pair newel))
             )
            )
            ;; The rest
            (t (setq newel (cons pair newel)))
          )
        )
        ;; Restoring order and modifying the object
        (entmod (reverse newel))
        (setq n (1+ n))
      )
    )
  )
  (princ)
)

If the Z coordinate is not displayed in the properties (example, for dimensions, for Mleader), then you need to use the _LIST command.

Don't think of me as a programmer...
The code is written using AI.

Edited Sunday at 01:58 PM by Nikon

[shokoufeh]

On 8/31/2025 at 5:03 PM, Steven P said:

 

Use what you have done previously but for dx code 10:

 

          (foreach dxf le
            (if (= (car dxf) 10)
              (setq le (subst (cons 10 (zeroz (cdr dxf))) dxf le))
            )
          )

 

I applied this and the problem is solved for Hatches, too. Thank you 

[shokoufeh]

On 8/31/2025 at 5:25 PM, Nikon said:

If all the primitives (TEXT,MTEXT,INSERT,LINE,LWP,Circle,Mleader,Dimension) are perceived as objects, 
then you can use this code:
 

;; Set coordinates of objects (TEXT,MTEXT,INSERT,LINE,LWP,Circle,Mleader,Dimension) Z in 0
(defun zeroz-in-list (lst /)
  (cond
    ;; The list of coordinates-vertex
    ((and (listp lst)
          (= (length lst) 2)
          (numberp (car lst))
          (numberp (cadr lst)))
      ;; if only XY - expanding to XYZ
      (list (car lst) (cadr lst) 0.0)
    )
    ((and (listp lst)
          (= (length lst) 3)
          (numberp (car lst))
          (numberp (cadr lst))
          (numberp (caddr lst)))
     ;; if already XYZ -  just do Z=0.0
     (list (car lst) (cadr lst) 0.0)
    )
    ;; If it's a large list, it's probably nested
    ((listp lst)
     (mapcar 'zeroz-in-list lst)
    )
    (t lst)
  )
)

(defun c:ObjZ0 (/ ss n e el newel)
  (prompt "
Select objects (all types, including polylines, mleader, dimension): ")
  (if (setq ss (ssget))
    (progn
      (setq n 0)
      (while (< n (sslength ss))
        (setq e (ssname ss n)
              el (entget e)
              newel nil
        )
        (foreach pair el
          (cond
            ;; height LWPOLYLINE (code 38)
            ((and (= (car pair) 38) (numberp (cdr pair)))
             (setq newel (cons (cons 38 0.0) newel))
            )
            ;;Point codes (for example, 10, 11, 12...), etc.
            ((and (numberp (car pair))
                  (not (= (car pair) 210))) ; Don't touch the normal
             (if (listp (cdr pair))
                 (setq newel (cons (cons (car pair) (zeroz-in-list (cdr pair))) newel))
                 (setq newel (cons pair newel))
             )
            )
            ;; The rest
            (t (setq newel (cons pair newel)))
          )
        )
        ;; Restoring order and modifying the object
        (entmod (reverse newel))
        (setq n (1+ n))
      )
    )
  )
  (princ)
)

If the Z coordinate is not displayed in the properties (example, for dimensions, for Mleader), then you need to use the _LIST command.

Don't think of me as a programmer...
The code is written using AI.

WOW. Great. It works 

Thank you 

[pefi]

Did you try FLATTEN command?

[Nikon]

19 hours ago, pefi said:

Did you try FLATTEN command?

The FLATTEN command explodes MLeader and does not work with dimensions.

[SLW210]

As I posted in the other similar thread, I have found for most cases both FLATTEN and FLATSHOT of very little use.

 

Posted somewhere on here are some TOOLBAR MACROs, which IMO does a better job for not too complex drawings to simply get a lot of basic objects to Z=0, as well as LISPs using the same method of moving everything then moving them all back.

 

Initially it was needed for LT, not sure if something better can be used for newer LT with LISP.

 

I'll repost the other thread which gives more on FLATTEN more complicated objects.

 

Performance helps for Large-Scale Z-Flattening (Z0) AutoLISP Routine? - AutoLISP, Visual LISP & DCL - AutoCAD Forums

[BlackBox]

2 hours ago, Nikon said:

The FLATTEN command explodes MLeader and does not work with dimensions.

This does: 

(defun c:FOO (/ *error* _move _set elev acDoc ss objName pt i)

  (defun *error* (msg)
    (if ss (vla-delete ss))
    (if acDoc (vla-endundomark acDoc))
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )

  (defun _move (prop /)
    (vla-move
      x
      (vlax-3d-point '(0 0 0))
      (vlax-3d-point
        (mapcar
          '-
          (list (car (setq pt (vlax-get x prop))) (cadr pt) elev)
          pt
        )
      )
    )
  )

  (defun _set (prop /)
    (vlax-put
      x
      prop
      (list (car (setq pt (vlax-get x prop)))
            (cadr pt)
            elev
      )
    )
  )

  (if
    (and
      (ssget
        "_:L"
        '(
          (0
            .
            "ARC,ATTDEF,CIRCLE,DIMENSION,ELLIPSE,HATCH,INSERT,*LEADER,LINE,*POLYLINE,MTEXT,POINT,REGION,SOLID,SPLINE,TEXT"
          )
         )
      )
      ;; someone asked if they could pick a point:
      ;;(setq elev (getpoint "\nSpecify point for elevation: "))
      ;;(setq elev (last elev))
      (setq elev (getreal "\nEnter an elevation: "))
    )
    (progn
      (vla-startundomark
        (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
      )
      (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
        (setq pt nil)
        (cond
          ((vl-position
             (setq objName (vla-get-objectname x))
             '("AcDbArc" "AcDbCircle" "AcDbEllipse")
           )
           (_set "center")
          )
          ((vl-position objName '("AcDbAttributeDefinition" "AcDbMText" "AcDbText"))
           (_set "insertionpoint")
          )
          ((wcmatch objName "AcDb*Dimension")
           (_move "textposition")
          )
          ((= "AcDbBlockReference" objName)
           ;; <-- test for and ignore xrefs here, if needed
           (_set "insertionpoint")
          )
          ((= "AcDbLine" objName)
           (_set "startpoint")
           (_set "endpoint")
          )
          ((= "AcDbPoint" objName)
           (_set "coordinates")
          )
          ((vl-position objName '("AcDbHatch" "AcDbPolyline" "AcDb2dPolyline"))
           (vla-put-elevation x elev)
          )
          ((vl-position objName '("AcDb3dPolyline" "AcDbLeader" "AcDbSolid"))
           (setq pt (vlax-get x 'coordinates))
           (setq i 0)
           (setq pt
                  (mapcar
                    (function
                      (lambda (n)
                        (setq i (1+ i))
                        (if (= 0 (rem i 3))
                          elev
                          n
                        )
                      )
                    )
                    pt
                  )
           )
           (vlax-put x 'coordinates pt)
          )
          ((= "AcDbMLeader" objName)
            (setq pt (vlax-invoke x 'GetLeaderLineVertices 0))
            (vla-move
              x
              (vlax-3d-point
                (setq pt (list (car pt) (cadr pt) (caddr pt)))
              )
              (vlax-3d-point (list (car pt) (cadr pt) elev))
            )
          )
          ((= "AcDbRegion" objName)
            (setq pt (vlax-get (car (setq i (vlax-invoke x 'explode)))
                               'startpoint
                     )
            )
            (vla-move
              x
              (vlax-3d-point
                (setq pt (list (car pt) (cadr pt) (nth 2 pt)))
              )
              (vlax-3d-point (list (car pt) (cadr pt) elev))
            )
            (foreach line i (vla-delete line))
          )
          ((= "AcDbSpline" objName)
           (if (= :vlax-true (vla-get-isplanar x))
             (progn
               (setq pt (vlax-get x 'controlpoints))
               (vla-move
                 x
                 (vlax-3d-point
                   (setq pt (list (car pt) (cadr pt) (nth 2 pt)))
                 )
                 (vlax-3d-point (list (car pt) (cadr pt) elev))
               )
             )
             (progn
               (setq x (entget (vlax-vla-object->ename x)))
               (setq x
                      (mapcar
                        (function
                          (lambda (p)
                            (cond
                              ((and (member (car p) '(10 11 12 13))
                                    (listp (cdr p))
                                    (= 3 (length (cdr p)))
                               )
                               (list (car p)
                                     (cadr p)
                                     (caddr p)
                                     elev
                               )
                              )
                              (t p)
                            )
                          )
                        )
                        x
                      )
               )
               (entmod x)
             )
           )
          )
          (T nil)
        )
      )
    )
  )

  (*error* nil)
)