How to get POINT objects PositionZ?

[ScoRm]

i made a simple code, but i dont know how to make it work

is this even right?

(defun c:pelevation nil(c:pointelevation))
(defun c:pointelevation (/ pt zed sss)

(princ "\n\nPlease select POINT Object ")
(setq pt (ssget "_:L" '((0 . "POINT"))))
(setq zed (caddr pt))

(princ "\n\nPlease select Other Objects now ")
(setq sss (ssget "_:L"))

(command"_.CHANGE" sss "" "_P" "_E" zed "")
)

 

i want to select a point and use that POINTs' positionZ as elevation for other objects

[dan20047]

You've assigned the variable PT to a selection set, which usually has more than one entity. My code below is meant as an example of getting a single entity using SSGET and then extracting data, in this case the insertion point. SSNAME is used to get the first element of the selection set (which only has one entity.) Note it uses an express tools error handler which I can't provide due to copywrite, but you can comment those lines out (with ACET). Also I added a single select flag for the SSGET.  (For more info see http://www.lee-mac.com/ssget.html). TRANS is used to convert absolute entity data insertion point to a local UCS point since I'm mixing ENTGET and COMMAND. Commands in lisp use the local UCS.

 

To get just the z value of a point use CADDR:

: (getpoint)
(25.7678988508333 28.421639254423 0.0)
: (caddr (getpoint))
0.0

 

 

;;; quick move text or insert from insertion point
(defun c:MS1  ( / ss1 e1 ins1)
  (ACET-ERROR-INIT (list (list "cmdecho" 0 "osnapcoord" 0 "osmode" (getvar "osmode")) T))
  (SETV "osmode" 1088)	;turn on insertion snap for text pick
  (if (and (setq ss1 (ssget "+.:S:E:L" '((0 . "INSERT,*TEXT"))))	;select one insert on unlocked layer
           (setq e1  (ssname ss1 0))					;get entity name
           (setq ins1 (trans (cdr (assoc 10 (entget e1))) 0 1))		;get insertion point
      ) ;and
    (progn
      (command "move" "si" e1 "non" ins1)
      (RSETV "osmode") ;reset to normal snaps for final pick
      (SAA_CMDACTIVE nil)
    ) ;progn
  ) ;if
  (ACET-ERROR-RESTORE)
)

;;;==========================================================
;;; SETV function saves setvar settings to be reset at end with RSETV
;;;     (setv "cmdecho" 0) set cmdecho off
;;;     (rsetv "cmdecho")  resets cmdecho (see below)
;;;   taken from Essential AutoLISP by Roy Harkow
;;;==========================================================
(defun SETV (sysvar newval / cmdnam)
  (setq cmdnam (read (strcat sysvar "1")))		;Create   [savevar]1
  (set cmdnam (getvar sysvar))				;Save     [savevar]'s value
  (setvar sysvar newval)					;Then set [savevar] to new value
)

(defun RSETV (sysvar / )
  (if (eval (read (strcat sysvar "1")))			;Only change if exists
    (progn
      (setq cmdnam (read (strcat sysvar "1")))		;Create   [savevar]1
      (setvar sysvar (eval cmdnam))				;Restore  [savevar]'s value
      (set cmdnam nil)
    ) ;end progn
  ) ;end if
)

;;;==========================================================
;;; Continue pausing until exited command mode
;;; nil = pause
;;; otherwise pass string to use
;;; credit unknown - possibly Roy Harkow
;;; usage example: (command "line" (SAA_CMDACTIVE nil))
;;;==========================================================
(defun SAA_CMDACTIVE ( passcmd / )
  (if (null passcmd) (setq passcmd pause))
  (while (not (= 0 (getvar "cmdactive")))
    (if (= 'LIST (type passcmd))
      (foreach x passcmd
        (command x)
      ) ;_foreach
      (command passcmd)
    ) ;_if
  ) ;end while
)

 

Edited February 18, 2021 by dan20047

[Isaac26a]

Maybe this can help you, it only works for lines and plines

(vl-load-com)
;;; Move objects to elevation (Z coordinate) defined by a point
;;; The objects can be LINE,LWPOLYLINE,MTEXT,TEXT,CIRCLE,ARC
;;; By Isaac A. Feb 2021
(defun c:ptelev (/ chm l list1 list2 n newele oldele p pt11 *osnap x x1 y y1)
   (setvar "cmdecho" 0)
   (vl-cmdf "_.undo" "_begin")
   (setq *osnap (getvar "osmode"))

   (setvar "osmode" 8)
   (setq pt11 (getpoint "\nSelect the reference point: ")
         newele (caddr pt11)
         newele (cons 38 newele)
   )
   (princ "\nSelect the elements to change elevation")
   (setq p (ssget (list (cons 0 "LINE,LWPOLYLINE,MTEXT,TEXT,CIRCLE,ARC"))))
   (setq chm 0
         l 0
         n (sslength p))
   (while (< l n)
      (if (= "LWPOLYLINE" (cdr (assoc 0 (setq e (entget (ssname p l))))))
         (progn
            (setq oldele (assoc 38 e)
)
            (entmod (subst newele oldele e))
            (setq chm (1+ chm))
         )
      )
      (if (or (= "LINE" (cdr (assoc 0 (setq e (entget (ssname p l)))))) (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname p l))))))
              (= "CIRCLE" (cdr (assoc 0 (setq e (entget (ssname p l)))))) (= "ARC" (cdr (assoc 0 (setq e (entget (ssname p l))))))
              (= "MTEXT" (cdr (assoc 0 (setq e (entget (ssname p l))))))
          )
         (progn
            (setq list1 (assoc 10 e)
                  x (cadr list1)
                  y (caddr list1)
                  list2 (list x y (caddr pt11))
                  list2 (cons 10 list2)
            
)
            (entmod (subst list2 list1 e))
            (setq chm (1+ chm))
         )
      )
      (if (= "LINE" (cdr (assoc 0 (setq e (entget (ssname p l))))))

         (progn
            (setq list3 (assoc 11 e)
                  x1 (cadr list3)
                  y1 (caddr list3)
                  list4 (list x1 y1 (caddr pt11))
                  list4 (cons 11 list4)
            
)
            (entmod (subst list4 list3 e))
         )
      )
      (setq l (1+ l))
   )
   (princ (strcat (rtos chm 2 0) " Objects modified."))

   (setvar "osmode" *osnap)
   (vl-cmdf "_.undo" "_end")
   (princ)
)

 

Edited February 18, 2021 by Isaac26a

[ScoRm]

2 hours ago, Isaac26a said:

Maybe this can help you, it only works for lines and plines

 

it did! thank you!

but i need to change others too like TEXT, MTEXT, LEADER, HATCH, CIRCLE

thats why i use "CHANGE"

but i will still use this.

Edited February 18, 2021 by ScoRm

[Isaac26a]

Quote

15 hours ago, ScoRm said:

but i need to change others too like TEXT, MTEXT, LEADER, HATCH, CIRCLE

 

Ok I updated the code so you can use it for LINE,LWPOLYLINE,MTEXT,TEXT,CIRCLE,ARC, I still owe you the Leader and Hatch.

Hope it works for you.

[ronjonp]

19 hours ago, Isaac26a said:

Maybe this can help you, it only works for lines and plines

(vl-load-com)
;;; Move objects to elevation (Z coordinate) defined by a point
;;; The objects can be LINE,LWPOLYLINE,MTEXT,TEXT,CIRCLE,ARC
;;; By Isaac A. Feb 2021
(defun c:ptelev (/ chm l list1 list2 n newele oldele p pt11 *osnap x x1 y y1)
   (setvar "cmdecho" 0)
   (vl-cmdf "_.undo" "_begin")
   (setq *osnap (getvar "osmode"))

   (setvar "osmode" 8)
   (setq pt11 (getpoint "\nSelect the reference point: ")
         newele (caddr pt11)
         newele (cons 38 newele)
   )
   (princ "\nSelect the elements to change elevation")
   (setq p (ssget (list (cons 0 "LINE,LWPOLYLINE,MTEXT,TEXT,CIRCLE,ARC"))))
   (setq chm 0
         l 0
         n (sslength p))
   (while (< l n)
      (if (= "LWPOLYLINE" (cdr (assoc 0 (setq e (entget (ssname p l))))))
         (progn
            (setq oldele (assoc 38 e)
)
            (entmod (subst newele oldele e))
            (setq chm (1+ chm))
         )
      )
      (if (or (= "LINE" (cdr (assoc 0 (setq e (entget (ssname p l)))))) (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname p l))))))
              (= "CIRCLE" (cdr (assoc 0 (setq e (entget (ssname p l)))))) (= "ARC" (cdr (assoc 0 (setq e (entget (ssname p l))))))
              (= "MTEXT" (cdr (assoc 0 (setq e (entget (ssname p l))))))
          )
         (progn
            (setq list1 (assoc 10 e)
                  x (cadr list1)
                  y (caddr list1)
                  list2 (list x y (caddr pt11))
                  list2 (cons 10 list2)
            
)
            (entmod (subst list2 list1 e))
            (setq chm (1+ chm))
         )
      )
      (if (= "LINE" (cdr (assoc 0 (setq e (entget (ssname p l))))))

         (progn
            (setq list3 (assoc 11 e)
                  x1 (cadr list3)
                  y1 (caddr list3)
                  list4 (list x1 y1 (caddr pt11))
                  list4 (cons 11 list4)
            
)
            (entmod (subst list4 list3 e))
         )
      )
      (setq l (1+ l))
   )
   (princ (strcat (rtos chm 2 0) " Objects modified."))

   (setvar "osmode" *osnap)
   (vl-cmdf "_.undo" "_end")
   (princ)
)

 

@Isaac26a FWIW...

;; This
(or (= "LINE" (cdr (assoc 0 (setq e (entget (ssname p l))))))
    (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname p l))))))
    (= "CIRCLE" (cdr (assoc 0 (setq e (entget (ssname p l))))))
    (= "ARC" (cdr (assoc 0 (setq e (entget (ssname p l))))))
    (= "MTEXT" (cdr (assoc 0 (setq e (entget (ssname p l))))))
)
;; Could be simplified to this :)
(wcmatch (cdr (assoc 0 (setq e (entget (ssname p l))))) "LINE,TEXT,CIRCLE,ARC,MTEXT")

 

[Isaac26a]

Quote

39 minutes ago, ronjonp said:

;; This (or (= "LINE" (cdr (assoc 0 (setq e (entget (ssname p l)))))) (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname p l)))))) (= "CIRCLE" (cdr (assoc 0 (setq e (entget (ssname p l)))))) (= "ARC" (cdr (assoc 0 (setq e (entget (ssname p l)))))) (= "MTEXT" (cdr (assoc 0 (setq e (entget (ssname p l)))))) ) ;; Could be simplified to this (wcmatch (cdr (assoc 0 (setq e (entget (ssname p l))))) "LINE,TEXT,CIRCLE,ARC,MTEXT")

 

Excelent Ronjonp, now I learned something new, thanks.

[ronjonp]

18 minutes ago, Isaac26a said:

Excelent Ronjonp, now I learned something new, thanks.

Glad to help 

[ScoRm]

On 2/18/2021 at 10:13 AM, Isaac26a said:

Maybe this can help you, it only works for lines and plines

 

thank you sir, i will use this! this will actually help me