LISP Request - Elevations

[Lee Mac]

Sorry dude - as usual I forgot to load the Visual LISP functions (vl-load-com).

 

I normally include it in my ACADDOC.lsp to automatically load the VL functions on start-up, but this means that when I test the lisps I post, I never notice that I have missed it

 

My sincere apologies.

 

(defun c:elab  (/ *error* ovar vlst doc spc ePt tPt tStr)
 [color=Red][b](vl-load-com)[/b][/color]

 (defun *error*  (msg)
   (if ovar
     (mapcar 'setvar vlst ovar))
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
     (princ (strcat "\nError: " msg))
     (princ "\n<<-- cancelled -->>"))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 (setq vlst '("CLAYER" "DIMZIN")
       ovar (mapcar 'getvar vlst))
 (setvar "DIMZIN" 1)

 (if (not (tblsearch "LAYER" "ELEVTEXT"))
   (vla-put-color (vla-add (vla-get-Layers doc) "ELEVTEXT") acYellow)
   (setvar "CLAYER" "ELEVTEXT"))

 (if (not (tblsearch "BLOCK" "eMark"))
   (Make_Block "eMark" (getvar 'TEXTSIZE)))

 (while (setq ePt (getpoint "\nSelect Elevation Point: "))
   (Put_Block (trans ePt 1 0) "eMark" "ELEVTEXT")
   (setq tPt (polar (trans ePt 1 0) 0 (* 2.5 (getvar "TEXTSIZE"))))
   (Make_Text tPt "T.O. STEEL" 0.0 1)
   (setq tStr (strcat "ELEV: " (rtos (cadr (trans ePt 1 0)) 4 4)))
   (Make_Text tPt tStr 0.0 3))
 (mapcar 'setvar vlst ovar)
 (princ))

(defun Make_Text  (pt val rot flag)
 (entmake (list (cons 0 "TEXT")
                (cons 8 "ELEVTEXT")
                (cons 10 pt)
                (cons 40 (getvar "TEXTSIZE"))
                (cons 1 val)
                (cons 50 rot)
                (cons 7 (getvar "TEXTSTYLE"))
                (cons 71 0)
                (cons 72 0)
                (cons 73 flag)
                (cons 11 pt))))

(defun Make_Block  (Nme Rad)

 (entmake (list (cons 0 "BLOCK")
                (cons 2 Nme)
                (cons 10 (list 0 0 0))
                (cons 70 0)))

 (entmake (list (cons 0 "CIRCLE")
                (cons 8 "0")
                (cons 10 (list 0 0 0))
                (cons 40 Rad)))

 (entmake (list (cons 0 "LINE")
                (cons 8 "0")
                (cons 10 (list 0 (* 2 Rad) 0))
                (cons 11 (list 0 (* -2 Rad) 0))))

 (entmake (list (cons 0 "LINE")
                (cons 8 "0")
                (cons 10 (list (* -2 Rad) 0 0))
                (cons 11 (list (* 2 Rad) 0 0))))

 (entmake (list '(0 . "HATCH")
                '(100 . "AcDbEntity")
                '(8 . "0")
                '(62 . 2)
                '(100 . "AcDbHatch")
                '(10 0 0 0)
                '(210 0 0 1)
                '(2 . "SOLID")
                '(70 . 1)
                '(71 . 0)
                '(91 . 1)
                '(92 . 7)
                '(72 . 1)
                '(73 . 1)
                '(93 . 3)
                '(10 0 0 0)
                '(42 . 0)
                (cons 10 (list 0 (* -1 Rad) 0))
                '(42 . 0.414214)
                (cons 10 (list Rad 0 0))
                '(42 . 0)
                '(97 . 0)
                '(75 . 0)
                '(76 . 1)
                '(47 . 0.0334902)
                '(98 . 1)
                '(10 4.67389 5.69586 0.0)))

 (entmake (list '(0 . "HATCH")
                '(100 . "AcDbEntity")
                '(8 . "0")
                '(62 . 2)
                '(100 . "AcDbHatch")
                '(10 0 0 0)
                '(210 0 0 1)
                '(2 . "SOLID")
                '(70 . 1)
                '(71 . 0)
                '(91 . 1)
                '(92 . 7)
                '(72 . 1)
                '(73 . 1)
                '(93 . 3)
                (cons 10 (list 0 Rad 0))
                '(42 . 0.414214)
                (cons 10 (list (* -1 Rad) 0 0))
                '(42 . 0)
                '(10 0 0 0)
                '(42 . 0)
                '(97 . 0)
                '(75 . 0)
                '(76 . 1)
                '(47 . 0.0334902)
                '(98 . 1)
                '(10 4.67389 5.69586 0.0)))

 (entmake (list (cons 0 "ENDBLK") (cons 8 "0"))))

(defun Put_Block  (pt Nme lay)
 (entmake (list (cons 0 "INSERT")
                (cons 8 lay)
                (cons 2 Nme)
                (cons 10 pt))))

[Bill Tillman]

The UCS change feature was not quite right. I think I resolved it by changing the line

 

(setq tStr (strcat "ELEV: " (rtos (cadr (trans ePt 1 0)) 4 4)))

 

to read

 

(setq tStr (strcat "ELEV: " (rtos (cadr (trans ePt 0 2)) 4 4)))

 

This seems to make it work the way I want it to now. And thanks, I haven't had the time to look over your code for drawing and hatching the elevation symbol on the fly but I will examine that in detail as it will be very helpfull for other tasks as well.

[Lee Mac]

Glad you got it working Bill -

 

I think the (trans 0 2) is needed for working in paperspace.. but I might be wrong.

 

If you do have any further questions on how the code is put together, just shout.

 

Lee