pyou Posted November 15, 2023 Posted November 15, 2023 (edited) Hi I found this great lisp and it does what it should be, but I would like to add more things to pick z value from , not only from text/mtext or manual input. for example I would like to select other vertex points/ Point feature/circle or block if possible to get their z value . Any ideas for modifications and tweaks? (vl-load-com) (defun nentsel-getreal ( / ent key n nbr) (setq nbr "") (princ (strcat "\nChoose 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) 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 (princ "\nObject is not text!") (nentsel-getreal)) ) ) (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"))) ) ) ) (defun c:3dpoly_xy_ENG ( / AcDoc Space msg_f msg_n n pt_f lst_pt lst_tmp pt_n nw_pl) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) msg_f "\nSpecify the end of the line .XY from, or [annUlate]: " msg_n "\nSpecify the end of the line .XY from, or [Close/annUlate]: " n 0 ) (while (null (setq pt_f (getpoint "\nSpecify the starting point of the polyline: .XY from "))) (princ "\nIncorrect point.") ) (setq pt_f (trans pt_f 1 0) lst_pt (list (list (car pt_f) (cadr pt_f) (nentsel-getreal))) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (initget "U UNDO annUlate _Undo UNDO annUlate") (while (and (setq pt_n (getpoint (trans pt_f 0 1) (if (< n 2) msg_f msg_n))) (/= pt_n "Close")) (if (listp pt_n) (progn (setq pt_n (trans pt_n 1 0) lst_pt (cons (list (car pt_n) (cadr pt_n) (nentsel-getreal)) lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1+ n) pt_f pt_n) ) (if (zerop n) (princ "\nAll segments are already undone.") (progn (setq lst_pt (cdr lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1- n) pt_f (getvar "lastpoint")) ) ) ) (if (< n 1) (initget "U UNDO annUlate _Undo UNDO annUlate") (initget "U UNDO annUlate Close _Undo UNDO Close annUlate") ) (redraw) (while (cdr lst_tmp) (grdraw (trans (car lst_tmp) 0 1) (trans (cadr lst_tmp) 0 1) 7) (setq lst_tmp (cdr lst_tmp))) ) (redraw) (setq nw_pl (vlax-invoke Space 'Add3DPoly (apply 'append (reverse lst_pt)))) (if (eq pt_n "Close") (vlax-put nw_pl 'Closed 1) ) (princ) ) Edited November 15, 2023 by pyou Quote
Tsuky Posted November 17, 2023 Posted November 17, 2023 With these modifications, does it seem to work? (vl-load-com) (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 ( / o mod ent key n nbr) (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"))) ) ) ) (defun c:3dpoly_xy_ENG ( / AcDoc Space msg_f msg_n n pt_f lst_pt lst_tmp pt_n nw_pl) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) msg_f "\nSpecify the end of the line .XY from, or [Undo]: " msg_n "\nSpecify the end of the line .XY from, or [Close/Undo]: " n 0 ) (while (null (setq pt_f (getpoint "\nSpecify the starting point of the polyline: .XY from "))) (princ "\nIncorrect point.") ) (setq pt_f (trans pt_f 1 0) lst_pt (list (list (car pt_f) (cadr pt_f) (nentsel-getreal))) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (initget "Undo _Undo") (while (and (setq pt_n (getpoint (trans pt_f 0 1) (if (< n 2) msg_f msg_n))) (/= pt_n "Close")) (if (listp pt_n) (progn (setq pt_n (trans pt_n 1 0) lst_pt (cons (list (car pt_n) (cadr pt_n) (nentsel-getreal)) lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1+ n) pt_f pt_n) ) (if (zerop n) (princ "\nAll segments are already undone.") (progn (setq lst_pt (cdr lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1- n) pt_f (getvar "lastpoint")) ) ) ) (if (< n 1) (initget "Undo _Undo") (initget "Undo Close _Undo Close") ) (redraw) (mapcar '(lambda (p1 p2) (grdraw (trans p1 0 1) (trans p2 0 1) 7)) lst_tmp (cdr lst_tmp)) ) (redraw) (setq nw_pl (vlax-invoke Space 'Add3DPoly (apply 'append (reverse lst_pt)))) (if (eq pt_n "Close") (vlax-put nw_pl 'Closed 1) ) (princ) ) 1 Quote
pyou Posted November 17, 2023 Author Posted November 17, 2023 7 hours ago, Tsuky said: With these modifications, does it seem to work? (vl-load-com) (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 ( / o mod ent key n nbr) (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"))) ) ) ) (defun c:3dpoly_xy_ENG ( / AcDoc Space msg_f msg_n n pt_f lst_pt lst_tmp pt_n nw_pl) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) msg_f "\nSpecify the end of the line .XY from, or [Undo]: " msg_n "\nSpecify the end of the line .XY from, or [Close/Undo]: " n 0 ) (while (null (setq pt_f (getpoint "\nSpecify the starting point of the polyline: .XY from "))) (princ "\nIncorrect point.") ) (setq pt_f (trans pt_f 1 0) lst_pt (list (list (car pt_f) (cadr pt_f) (nentsel-getreal))) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (initget "Undo _Undo") (while (and (setq pt_n (getpoint (trans pt_f 0 1) (if (< n 2) msg_f msg_n))) (/= pt_n "Close")) (if (listp pt_n) (progn (setq pt_n (trans pt_n 1 0) lst_pt (cons (list (car pt_n) (cadr pt_n) (nentsel-getreal)) lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1+ n) pt_f pt_n) ) (if (zerop n) (princ "\nAll segments are already undone.") (progn (setq lst_pt (cdr lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1- n) pt_f (getvar "lastpoint")) ) ) ) (if (< n 1) (initget "Undo _Undo") (initget "Undo Close _Undo Close") ) (redraw) (mapcar '(lambda (p1 p2) (grdraw (trans p1 0 1) (trans p2 0 1) 7)) lst_tmp (cdr lst_tmp)) ) (redraw) (setq nw_pl (vlax-invoke Space 'Add3DPoly (apply 'append (reverse lst_pt)))) (if (eq pt_n "Close") (vlax-put nw_pl 'Closed 1) ) (princ) ) No unfortunately it does not pick up attribute z value, always keeps as 0 Quote
Tsuky Posted November 18, 2023 Posted November 18, 2023 1 hour ago, pyou said: No unfortunately it does not pick up attribute z value, always keeps as 0 @pyou "OSMODE" must be non-zero (set according to your choice: "end" "mid" "ins") before using the routine and moving the cursor over an object will then display the Z if the object is in 3D 1 Quote
pyou Posted November 18, 2023 Author Posted November 18, 2023 18 hours ago, Tsuky said: @pyou "OSMODE" must be non-zero (set according to your choice: "end" "mid" "ins") before using the routine and moving the cursor over an object will then display the Z if the object is in 3D Oh right! It works perfect. Thanks Tsuky Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.