MatchZ lisp code

[pyou]

Hi

 

Maybe someone could help me with this code.  I would like to store z properties for any object or 3d polyline and match  stored value to another.  Snapping options seems to be working , but nothing else.

 

Thank you for your consideration

 

(vl-load-com)

(defun c:MatchZ (/ ent1 ent2 z1 z2)
  (defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o)
    (setq n (/ (cadr (getvar "screensize")) 5.0))
    (setq pt (osnap pt-i str-md))
    (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o))
      (repeat 2
        (setq
          rap (/ (getvar "viewsize") n)
          pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt))
          pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt))
          pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt))
          pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt))
          pt5 (list (car pt) (- (cadr pt) rap) (caddr pt))
          pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt))
          pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt))
          pt8 (list (- (car pt) rap) (cadr pt) (caddr pt))
          pt56 (polar pt (- (/ pi 4.0)) rap)
          pt67 (polar pt (/ pi 4.0) rap)
          pt78 (polar pt (- pi (/ pi 4.0)) rap)
          pt85 (polar pt (+ pi (/ pi 4.0)) rap)
          n (- n 16)
        )
        (if (equal (osnap pt-i md) pt) (setq one_o T))
        (cond
          ((and (eq "_end" md) one_o)
            (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1)
          )
          ((and (eq "_mid" md) one_o)
            (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1)
          )
          ((and (eq "_cen" md) one_o)
            (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
            (grdraw pt5 pt7 7) (grdraw pt6 pt8 7)
          )
          ((and (eq "_nod" md) one_o)
            (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
            (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
          )
          ((and (eq "_qua" md) one_o)
            (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1)
          )
          ((and (eq "_int" md) one_o)
            (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
          )
          ((and (eq "_ins" md) one_o)
            (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1)
          )
          ((and (eq "_per" md) one_o)
            (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1)
          )
          ((and (eq "_tan" md) one_o)
            (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
            (grdraw pt3 pt4 1)
          )
          ((and (eq "_nea" md) one_o)
            (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1)
          )
        )
      )
      (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0))
    )
  )

  (defun nentsel-getreal ()
    (setq o (getvar "osmode"))
    (if (or (zerop o) (eq (boole 1 o 16384) 16384))
      (setq mod "_none")
      (progn
        (setq mod "")
        (mapcar
          '(lambda (xi xs)
            (if (not (zerop (boole 1 o xi)))
              (if (zerop (strlen mod))
                (setq mod (strcat mod xs))
                (setq mod (strcat mod "," xs))
              )
            )
          )
          '(1 2 4 8 16 32 64 128 256 512 2048 4096 8192)
          '("_endp" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_appint" "_ext" "_par")
        )
      )
    )
    (setq nbr "")
    (princ (strcat "\nSpecify a point at [" mod "] of, or choose Text/Multiline Text/Attribute to get Z <" (rtos (caddr (getvar "LASTPOINT")) 2 2) ">: "))
    (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25) (/= (car key) 3))
      (cond
        ((eq (car key) 5)
          (redraw)
          (mapcar '(lambda (p1 p2) (grdraw (trans p1 0 1) (trans p2 0 1) 7)) lst_tmp (cdr lst_tmp))
          (if (and (/= mod "_none") (osnap (cadr key) mod))
            (progn (gr-osmode (cadr key) mod) (repeat 128 (princ "\010")) (princ (caddr (osnap (cadr key) mod))))
          )
        )
        ((eq (car key) 2)
          (if (member (cadr key) '(8 46 48 49 50 51 52 53 54 55 56 57))
            (if (eq (cadr key) 8)
              (progn
                (princ (chr 8)) (princ (chr 32)) (princ (chr 8))
                (setq nbr (substr nbr 1 (1- (strlen nbr))))
              )
              (progn
                (setq n (chr (cadr key)))
                (princ n)
                (setq nbr (strcat nbr n))
              )
            )
          )
        )
      )
    )
    (if (eq (car key) 3)
      (if (setq ent (nentselp (cadr key)))
        (progn
          (setq ent (entget (car ent)))
          (if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB"))
            (progn
              (setq ent (read (cdr (assoc 1 ent))))
              (if (or (eq (type ent) 'INT) (eq (type ent) 'REAL))
                (progn (princ (strcat "\nZ = " (rtos ent 2 2))) ent)
                (progn (princ "\nInvalid text!") (nentsel-getreal))
              )
            )
            (progn
              (setq nbr "")
              (if (osnap (cadr key) mod)
                (setvar "LASTPOINT" (osnap (cadr key) mod))
                (nentsel-getreal)
              )
              (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT")) 2 2))) (caddr (getvar "LASTPOINT"))
            )
          )
        )
        (progn (princ "\nEmpty selection!") (setq ent nil) (nentsel-getreal))
      )
      (if (/= nbr "")
        (progn (princ (strcat "\nZ = " nbr)) (atof nbr))
        (progn (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT"))2 2))) (caddr (getvar "LASTPOINT")))
      )
    )
  )

  (setq ent1 (nentsel-getreal))
  (setq z1 (caddr ent1))
  (setq ent2 (nentsel-getreal))
  (setq z2 (caddr ent2))
  (command "move" (cadr ent2) "" (list 0.0 0.0 (- z1 z2)))
  (princ)
)

 

Edited February 24 by pyou