Text Height Markers for 2D Elevation/Section drawings

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

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))

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

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?

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

July 8, 2010

Ok, I shall have to update the code to work in all UCS...

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...

:-(

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

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))

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)
)

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 !!!

August 10, 2011

Could you provide an image of the result you are looking for?

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

August 11, 2011

I apologize for my bad English, I wrote this lisp

I hope it will be useful.

SimbQuota9-EN.lsp

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 !!!

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])
)

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))))

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.

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*

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

Text Height Markers for 2D Elevation/Section drawings

Recommended Posts

Brett_omega

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Lee Mac

Link to comment

Share on other sites

Brett_omega

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Brett_omega

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Brett_omega

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Barteek

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Barteek

Link to comment

Share on other sites

zanze

Link to comment

Share on other sites

Barteek

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

sachindkini

Link to comment

Share on other sites

Barteek

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Barteek

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity