Brett_omega Posted July 8, 2010 Share Posted July 8, 2010 Hello all, I have used the search function to try to answer my query, but to no avail. I am after a lisp routine that will place a piece of text with the Y value (to 2 decimal places) and a downward pointing triangle at a selected point in a drawing. I'm going to assume that the height information will need to be supplied by picking a horizontal datum line in the drawing and typing in the Y value of that line? I'm completely new to creating lisps so I thought I'd take a punt to see if anyone has done one, is doing one or has spotted one somewhere??? Thanks Guys Brett Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 8, 2010 Share Posted July 8, 2010 I wrote this a while back, it should be on here somewhere... (defun c:ellev (/ *error* Line Text OLDDIM P1 P2 PT TSZE X Y) ;; Lee Mac ~ 01.03.10 (defun *error* (msg) (and oldDim (setvar 'DIMZIN oldDim)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) (defun Text (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 (angle '(0 0 0) (getvar 'UCSXDIR))) (cons 7 (getvar 'TEXTSTYLE))))) (setq oldDim (getvar 'DIMZIN)) (setvar 'DIMZIN 0) (or *scl (setq *scl 100)) (initget 6) (setq *scl (cond ((getint (strcat "\nEnter Drawing Scale <" (itoa *scl) "> : "))) (*scl))) (setq tsze (* 0.002 *scl)) (while (setq pt (getpoint "\nPick Elevation Line Point: ")) (setq x (car pt) y (cadr pt)) (setq p1 (trans (list (- x (/ tsze 2)) (+ y tsze) 0.) 1 0) p2 (trans (list (+ x (/ tsze 2)) (+ y tsze) 0.) 1 0)) (mapcar (function (lambda (x) (line (trans pt 1 0) x))) (list p1 p2)) (line p1 p2) (Text (trans (list x (+ y tsze) 0.) 1 0) tsze (strcat (if (<= 0 y) "+" "") (rtos y 2 2)))) (setvar 'DIMZIN oldDim) (princ)) Quote Link to comment Share on other sites More sharing options...
Brett_omega Posted July 8, 2010 Author Share Posted July 8, 2010 I wrote this a while back, it should be on here somewhere... (defun c:ellev (/ *error* Line Text OLDDIM P1 P2 PT TSZE X Y) ;; Lee Mac ~ 01.03.10 (defun *error* (msg) (and oldDim (setvar 'DIMZIN oldDim)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) (defun Text (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 (angle '(0 0 0) (getvar 'UCSXDIR))) (cons 7 (getvar 'TEXTSTYLE))))) (setq oldDim (getvar 'DIMZIN)) (setvar 'DIMZIN 0) (or *scl (setq *scl 100)) (initget 6) (setq *scl (cond ((getint (strcat "\nEnter Drawing Scale <" (itoa *scl) "> : "))) (*scl))) (setq tsze (* 0.002 *scl)) (while (setq pt (getpoint "\nPick Elevation Line Point: ")) (setq x (car pt) y (cadr pt)) (setq p1 (trans (list (- x (/ tsze 2)) (+ y tsze) 0.) 1 0) p2 (trans (list (+ x (/ tsze 2)) (+ y tsze) 0.) 1 0)) (mapcar (function (lambda (x) (line (trans pt 1 0) x))) (list p1 p2)) (line p1 p2) (Text (trans (list x (+ y tsze) 0.) 1 0) tsze (strcat (if (<= 0 y) "+" "") (rtos y 2 2)))) (setvar 'DIMZIN oldDim) (princ)) Holy mackeral that was quick!!! That seems to be perfect. Only problem is I can't see the text. Also will changing the 5th to last line part ("+" "") to "" "m" will that result in the value becoming suffixed with m. Example 22.50m Thanks Lee Brett Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 8, 2010 Share Posted July 8, 2010 With 'm' suffix (defun c:ellev (/ *error* Line Text OLDDIM P1 P2 PT TSZE X Y) ;; Lee Mac ~ 01.03.10 (defun *error* (msg) (and oldDim (setvar 'DIMZIN oldDim)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) (defun Text (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 (angle '(0 0 0) (getvar 'UCSXDIR))) (cons 7 (getvar 'TEXTSTYLE))))) (setq oldDim (getvar 'DIMZIN)) (setvar 'DIMZIN 0) (or *scl (setq *scl 100)) (initget 6) (setq *scl (cond ((getint (strcat "\nEnter Drawing Scale <" (itoa *scl) "> : "))) (*scl))) (setq tsze (* 0.002 *scl)) (while (setq pt (getpoint "\nPick Elevation Line Point: ")) (setq x (car pt) y (cadr pt)) (setq p1 (trans (list (- x (/ tsze 2)) (+ y tsze) 0.) 1 0) p2 (trans (list (+ x (/ tsze 2)) (+ y tsze) 0.) 1 0)) (mapcar (function (lambda (x) (line (trans pt 1 0) x))) (list p1 p2)) (line p1 p2) (Text (trans (list x (+ y tsze) 0.) 1 0) tsze (strcat (if (<= 0 y) "+" "") (rtos y 2 2) "m"))) (setvar 'DIMZIN oldDim) (princ)) As for you not seeing the text - is it not there, or just too small? Quote Link to comment Share on other sites More sharing options...
Brett_omega Posted July 8, 2010 Author Share Posted July 8, 2010 its there, but not visible. It's becuase i'm not in the WCS and its flat as i look at the drawing. I'm drawing an elevation off a 3d laser scan so won't use it yet. It works in another drawing. Nice one fella! Brett Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 8, 2010 Share Posted July 8, 2010 Ok, I shall have to update the code to work in all UCS... Quote Link to comment Share on other sites More sharing options...
Brett_omega Posted July 8, 2010 Author Share Posted July 8, 2010 The last one you did is fine for the purpose I will need it for. Is there any way of offsetting the text to sit just above the triangle. I can't see the text justification in your code. Like i said, I'm brand new to trying to do these, as in last night... :-( Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 8, 2010 Share Posted July 8, 2010 Hi Brett, The text justification is as per the textstyle set in your drawing - it can be set manually however. The offset above the triangle is by the textsize. Lee Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 8, 2010 Share Posted July 8, 2010 This would be Middle-Center justification, and I've also added an offset factor: (defun c:ellev (/ *error* Line Text OFFSET OLDDIM P1 P2 PT TSZE X Y) ;; Lee Mac ~ 01.03.10 [color=Red][b] (setq offset 1.5) ;; Text Offset[/b][/color] (defun *error* (msg) (and oldDim (setvar 'DIMZIN oldDim)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) (defun Text (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 (angle '(0 0 0) (getvar 'UCSXDIR))) (cons 7 (getvar 'TEXTSTYLE)) [color=Red][b] (cons 72 1) ; Center (cons 73 2) ; Middle[/b][/color] (cons 11 pt)))) (setq oldDim (getvar 'DIMZIN)) (setvar 'DIMZIN 0) (or *scl (setq *scl 100)) (initget 6) (setq *scl (cond ((getint (strcat "\nEnter Drawing Scale <" (itoa *scl) "> : "))) (*scl))) (setq tsze (* 0.002 *scl)) (while (setq pt (getpoint "\nPick Elevation Line Point: ")) (setq x (car pt) y (cadr pt)) (setq p1 (trans (list (- x (/ tsze 2)) (+ y tsze) 0.) 1 0) p2 (trans (list (+ x (/ tsze 2)) (+ y tsze) 0.) 1 0)) (mapcar (function (lambda ( x ) (line (trans pt 1 0) x))) (list p1 p2)) (line p1 p2) (Text (trans (list x (+ y (* offset tsze)) 0.) 1 0) tsze (strcat (if (<= 0 y) "+" "") (rtos y 2 2) "m"))) (setvar 'DIMZIN oldDim) (princ)) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 8, 2010 Share Posted July 8, 2010 With the kind help of Gile over at theSwamp, this should work in all UCS/views: (defun c:ellev ( / *error* Text OFFSET OLDDIM P1 P2 PT TSZE X Y Z ) ;; © Lee Mac 2010 (setq offset 1.5) ;; Text Offset (defun *error* ( msg ) (and oldDim (setvar 'DIMZIN oldDim)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (defun Text ( pt hgt str rot norm ) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 rot) (cons 7 (getvar 'TEXTSTYLE)) (cons 72 1) ; Center (cons 73 2) ; Middle (cons 11 pt) (cons 210 norm) ) ) ) (setq oldDim (getvar 'DIMZIN)) (setvar 'DIMZIN 0) (or *scl (setq *scl 100)) (initget 6) (setq *scl (cond ( (getint (strcat "\nEnter Drawing Scale <" (itoa *scl) "> : ")) ) ( *scl ) ) ) (setq tsze (* 0.002 *scl)) (setq norm (trans '(0. 0. 1.) 1 0 t)) (setq rot (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 norm t))) (terpri) (while (setq pt (getpoint "\rPick Elevation Line Point: ")) (setq txt (strcat (if (<= 0 (cadr pt)) "+" "") (rtos (cadr pt) 2 2) "m")) (setq pt (trans pt 1 norm)) ; UCS->OCS (setq x (car pt) y (cadr pt) z (caddr pt)) (setq p1 (polar pt (+ rot (/ pi 3)) tsze) p2 (polar pt (+ rot (/ (* 2 pi) 3)) tsze)) (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) '(70 . 1) (cons 38 z) (cons 10 pt) (cons 10 p1) (cons 10 p2) (cons 210 norm) ) ) (Text (list x (+ y (* offset tsze)) z) tsze txt rot norm ) ) (setvar 'DIMZIN oldDim) (princ) ) Quote Link to comment Share on other sites More sharing options...
Barteek Posted August 10, 2011 Share Posted August 10, 2011 would it be possible to make it in the way that it will appear on left side with a line from bottom of that arrow to a measuring point. in mm without units and this plus in front?? MANY THANKS IN ADVANCE !!! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 10, 2011 Share Posted August 10, 2011 Could you provide an image of the result you are looking for? Quote Link to comment Share on other sites More sharing options...
Barteek Posted August 11, 2011 Share Posted August 11, 2011 Hi thank you for a quick reaction on my post. here is a sample PDF how it could look like. SAMPLE.pdf Quote Link to comment Share on other sites More sharing options...
zanze Posted August 11, 2011 Share Posted August 11, 2011 I apologize for my bad English, I wrote this lisp I hope it will be useful. SimbQuota9-EN.lsp Quote Link to comment Share on other sites More sharing options...
Barteek Posted August 11, 2011 Share Posted August 11, 2011 Thank you for your help. Unfortunately it makes only one measuring and then you need to replay command (or I'm doing something wrong). I need to make couple measuring's on one drawing just like LSP from Lee Mac does. But one more time MANY THANKS !!! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 11, 2011 Share Posted August 11, 2011 Hi Barteek, Give the following a try: ([color=BLUE]defun[/color] c:em ( [color=BLUE]/[/color] *error* nm p1 p2 p3 p4 ts tx xa ) [color=GREEN];; Elevation Marker[/color] [color=GREEN];; © Lee Mac 2011 - www.lee-mac.com[/color] ([color=BLUE]defun[/color] *error* ( msg ) ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg) [color=MAROON]"*BREAK,*CANCEL*,*EXIT*"[/color])) ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\n** Error: "[/color] msg [color=MAROON]" **"[/color])) ) ([color=BLUE]princ[/color]) ) ([color=BLUE]setq[/color] ts ([color=BLUE]getvar[/color] 'TEXTSIZE) nm ([color=BLUE]trans[/color] '(0.0 0.0 1.0) 1 0 [color=BLUE]t[/color]) xa ([color=BLUE]angle[/color] '(0.0 0.0 0.0) ([color=BLUE]trans[/color] ([color=BLUE]getvar[/color] 'UCSXDIR) 0 nm [color=BLUE]t[/color])) ) ([color=BLUE]terpri[/color]) ([color=BLUE]while[/color] ([color=BLUE]setq[/color] p1 ([color=BLUE]getpoint[/color] [color=MAROON]"\rPick Elevation Line Point: "[/color])) ([color=BLUE]setq[/color] tx ([color=BLUE]rtos[/color] ([color=BLUE]cadr[/color] p1)) p2 ([color=BLUE]polar[/color] p1 ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.) ([color=BLUE]*[/color] ts ([color=BLUE]/[/color] ([color=BLUE]sqrt[/color] 3.0) 2.0))) p3 ([color=BLUE]polar[/color] p2 [color=BLUE]pi[/color] ([color=BLUE]*[/color] ts ([color=BLUE]strlen[/color] tx))) p4 ([color=BLUE]polar[/color] ([color=BLUE]polar[/color] p2 [color=BLUE]pi[/color] ([color=BLUE]*[/color] ts 0.5 ([color=BLUE]strlen[/color] tx))) ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.) ts) ) ([color=BLUE]foreach[/color] sym '(p1 p2 p3 p4) ([color=BLUE]set[/color] sym ([color=BLUE]trans[/color] ([color=BLUE]eval[/color] sym) 1 nm))) ([color=BLUE]entmakex[/color] ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 0 [color=MAROON]"LWPOLYLINE"[/color]) ([color=BLUE]cons[/color] 100 [color=MAROON]"AcDbEntity"[/color]) ([color=BLUE]cons[/color] 100 [color=MAROON]"AcDbPolyline"[/color]) ([color=BLUE]cons[/color] 90 3) ([color=BLUE]cons[/color] 70 0) ([color=BLUE]cons[/color] 38 ([color=BLUE]caddr[/color] p1)) ([color=BLUE]cons[/color] 10 p1) ([color=BLUE]cons[/color] 40 0.0) ([color=BLUE]cons[/color] 41 ts) ([color=BLUE]cons[/color] 10 p2) ([color=BLUE]cons[/color] 40 ([color=BLUE]*[/color] ts 0.05)) ([color=BLUE]cons[/color] 41 ([color=BLUE]*[/color] ts 0.05)) ([color=BLUE]cons[/color] 10 p3) ([color=BLUE]cons[/color] 210 nm) ) ) ([color=BLUE]entmakex[/color] ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 0 [color=MAROON]"TEXT"[/color]) ([color=BLUE]cons[/color] 7 ([color=BLUE]getvar[/color] 'TEXTSTYLE)) ([color=BLUE]cons[/color] 1 tx) ([color=BLUE]cons[/color] 50 xa) ([color=BLUE]cons[/color] 40 ts) ([color=BLUE]cons[/color] 10 p4) ([color=BLUE]cons[/color] 72 1) ([color=BLUE]cons[/color] 73 2) ([color=BLUE]cons[/color] 11 p4) ([color=BLUE]cons[/color] 210 nm) ) ) ) ([color=BLUE]princ[/color]) ) Quote Link to comment Share on other sites More sharing options...
sachindkini Posted August 12, 2011 Share Posted August 12, 2011 Dear Sir, program by mr. lee mac its very use full http://www.cadtutor.net/forum/showthread.php?31363-floor-amp-height-lsp ; Multiple Floor Height by Lee McDonnell 14th January 2009 ; Places Height and Floor Text above Midpoint on Floor Level Line. ; [if Polyline, Assumes only two Vertices.] ; [Assumes Lines are Parallel] (defun c:fht (/ varlist oldvars cCurve cVlist cAng cMpt cStpt cEnpt dCurve fStr dVlist dStpt dEnpt dAng) (vl-load-com) (setq varlist (list "CMDECHO" "CLAYER") oldvars (mapcar 'getvar varlist)) (setvar "CMDECHO" 0) (if (and (setq cCurve (car (entsel "\nSelect Ground Floor > "))) (member (cdr (assoc 0 (entget cCurve))) '("LINE" "LWPOLYLINE"))) (progn (if (not (tblsearch "LAYER" "TEXT")) (vl-cmdf "-layer" "M" "TEXT" "C" "2" "TEXT" "")) (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget cCurve)))) (setq cVlist (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget cCurve))) cAng (angle (nth 0 cVlist)(nth 1 cVlist)) cMpt (polar (nth 0 cVlist) cAng (/ (distance (nth 0 cVlist)(nth 1 cVlist)) 2))) (if (>= cAng pi) (setq cAng (- cAng pi))) (Make_Text (polar cMpt (+ cAng (/ pi 2)) 2.0) "%%P0.00 Mt. Gr. Level" cAng)) ((= "LINE" (cdr (assoc 0 (entget cCurve)))) (setq cStpt (cdr (assoc 10 (entget cCurve))) cEnpt (cdr (assoc 11 (entget cCurve))) cAng (angle cStpt cEnpt) cMpt (polar cStpt cAng (/ (distance cStpt cEnpt) 2))) (if (> cAng pi) (setq cAng (- cAng pi))) (if (= cAng pi) (setq cAng 0.0)) (Make_Text (polar cMpt (+ cAng (/ pi 2)) 2.0) "%%P0.00 Mt. Gr. Level" cAng))) (while (and (setq dCurve (car (entsel "\nSelect a Floor > "))) (member (cdr (assoc 0 (entget dCurve))) '("LINE" "LWPOLYLINE")) (/= (setq fStr (getstring t "\nSpecify Name of Floor > ")) "")) (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget dCurve)))) (setq dVlist (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget dCurve))) dAng (angle (nth 0 dVlist)(nth 1 dVlist)) cdDist (distance (vlax-curve-getClosestPointto dCurve cMpt T) cMpt)) (cond ((> (/ (* 3 pi) 2) dAng (/ pi 2)) (setq dAng (- dAng pi))) ((= dAng pi) (setq dAng 0.0))) (Make_Text (polar cMpt (+ dAng (/ pi 2)) (+ cdDist 2)) (strcat "+" (rtos cdDist 2 2) " Mt. " fStr) dAng)) ((= "LINE" (cdr (assoc 0 (entget dCurve)))) (setq dStpt (cdr (assoc 10 (entget dCurve))) dEnpt (cdr (assoc 11 (entget dCurve))) dAng (angle dStpt dEnpt) cdDist (distance (vlax-curve-getClosestPointto dCurve cMpt T) cMpt)) (cond ((> (/ (* 3 pi) 2) dAng (/ pi 2)) (setq dAng (- dAng pi))) ((= dAng pi) (setq dAng 0.0))) (Make_Text (polar cMpt (+ dAng (/ pi 2)) (+ cdDist 2)) (strcat "+" (rtos cdDist 2 2) " Mt. " fStr) dAng))))) (princ "\n<!> No Floor Selected <!> ")) (mapcar 'setvar varlist oldvars) (princ)) (defun Make_Text (txt_pt txt_val txt_ang) (entmake (list '(0 . "TEXT") '(8 . "TEXT") (cons 10 txt_pt) (cons 40 (max 2.5 (getvar "TEXTSIZE"))) (cons 1 txt_val) (cons 50 txt_ang) '(7 . "STANDARD") '(71 . 0) '(72 . 1) '(73 . 2) (cons 11 txt_pt)))) Quote Link to comment Share on other sites More sharing options...
Barteek Posted August 17, 2011 Share Posted August 17, 2011 This one is looking fantastic only thing is can you put in a scale option like you had it before because they are very small. Let me know how can I repay You are doing fantastic job. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 17, 2011 Share Posted August 17, 2011 This one is looking fantastic only thing is can you put in a scale option like you had it before because they are very small. The height is currently controlled by the TEXTSIZE System Variable - perhaps the DIMTXT System Variable may be better? Let me know how can I repay You are doing fantastic job. *cough* donate buttons on my site *cough* Quote Link to comment Share on other sites More sharing options...
Barteek Posted August 17, 2011 Share Posted August 17, 2011 Ok you are right that works. Just small change can we skip those 2 zeros after a dot and then its perfect(sorry for that in last one i did change it) . Can you do some other custom Lsp's for cad If I will have a request ? just wright me on my private mail Quote Link to comment Share on other sites More sharing options...
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.