Lisp for place Station and Elevation

[bijoyvm]

hi friends,

This Stan-Elev lisp help you to place or check Station and Elevation of a profile

Steps:-

1. Load stn-elev lisp file

2. Set datum origin using command “ DAT ”

a. Enter station datum

b. Enter Elevation datum

c. Pick datum origin

 

3. Place station and elevation text by using command “ STN ”

a. Enter Vertical Scale factor

b. Pick Station Elevation point

c. Pick Text Location

 

4. Reset the datum origin to world by using command “ UW “

(always set UCS origin to World before closing the file)

Specifications:

New layer = prf_eltext

New dimension style = Dim Arrow Ann (this annotative dimension style will help you to change the text size by changing Annotative scale value)

Background mask Applied to the text

 

*****************************************************

Thank you for my cadtutor friends to help me to create this Lisp

 

*****************************************************

 

Stn-Elev.lsp

[stevesfr]

This is interesting and somewhat useful, I assume its metric notation. I'll see if I can convert to imperial and have the stations report as X+xx.xx (feet)

nice code...

Steve

[bijoyvm]

thanks steve...

[bijoyvm]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Title : Station & Elevation

;; Purpose : To get Stn & pgl

;; Written : Bijoy.v.m

;; Date : Oct 2010

;; System requirement : Autocad 2007

;; Command : Dat, Stn & uw

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

;;----------------------------------------Sub Function to Add sep (+)------------------------------------

(defun annotate (/ text1 dec sep)

 

(setq sep "+")

 

(setq dec 3) ;;supress 0 if 3 digit eg 12.555 to 12.555

;; (if (= (substr text (strlen text) 1) "0") (setq dec 2)) ;;supress 0 if 2 digit eg 12.550 to 12.55

;; (if (= (substr text (1- (strlen text)) 2) "00") (setq dec 1)) ;;supress 0 if 1 digit eg 12.500 to 12.5

(if (= (substr text (- (strlen text) 2) 3) "000") (setq dec 0)) ;;supress 0 if 0 digit eg 12.000 to 12

 

(setq text1 (atof text))

 

(if (not (= (substr text 1 1) "-"))

(setq txt (strcat (rtos (fix (/ text1 1000)) 2 0) sep (substr (rtos (+ 1000 (rem text1 1000)) 2 dec) 2))) ;new code

(setq txt text)

) ;if

) ;defun

;;--------------------------------------Sub Function to Create Styles------------------------------------

 

(defun Styles()

 

;create text Style

 

(if (not (tblsearch "style" "Gen-Text")) (command "-style" "Gen-Text" "Arial.ttf" "A""yes" "No" 3.0 "1" 0 "n" "n"))

 

;create dimension style

 

(if (not (tblsearch "DImstyle" "Dim Arrow Ann"))

(progn

(command "dim" "style" "Gen-Text"

"DIMADEC" 0

"DIMALT" 0

"DIMALTD" 2

"DIMALTF" 1.000

"DIMALTRND" 0.0000

"DIMALTTD" 2

"DIMALTTZ" 0

"DIMALTU" 2

"DIMALTZ" 0

"DIMASZ" 3

"DIMATFIT" 3

"DIMAUNIT" 0

"DIMAZIN" 0

"DIMBLK" ""

"DIMBLK1" ""

"DIMBLK2" ""

"DIMLDRBLK" ""

"DIMCEN" 0

"DIMCLRD" 7

"DIMCLRE" 7

"DIMCLRT" 7

"DIMDEC" 0

"DIMDLE" 0.0000

"DIMDLI" 1.0000

"DIMEXE" 1.5000

"DIMEXO" 1.5000

"DIMFRAC" 0

"DIMGAP" 1.0000

"DIMJUST" 0

"DIMLFAC" 1000.0000

"DIMLIM" 0

"DIMLUNIT" 2

"DIMLWD" 0

"DIMLWE" 0

"DIMRND" 0.0000

"DIMSAH" 0

"DIMSCALE" 1.0000

"DIMSD1" 0

"DIMSD2" 0

"DIMSE1" 0

"DIMSE2" 0

"DIMSOXD" 0

"DIMTAD" 1

"DIMTDEC" 0

"DIMTIH" 0

"DIMTIX" 0

"DIMTM" 0.0000

"DIMTMOVE" 0

"DIMTOFL" 0

"DIMTOH" 0

"DIMTSZ" 0.0000

"DIMTVP" 0.0000

"DIMTXSTY" "Gen-Text"

"DIMTXT" 3.000

"DIMZIN" 0

"DIMFIT" 5 /e)

 

(command "dimstyle" "An" "y" "Dim Arrow Ann" "S" "")

) ;progn

) ;if

 

) ;defun

;;-------------------------------------------* error *----------------------------------------------------

(defun trap1 (errmsg)

(setq *error* temperr)

(setvar "clayer" clay)

(prompt "\nEnter Command UW to make UCS origin World © Bijoy.v.m AECOM Dubai")

(princ)

) ;defun

;;-------------------------------------------Set Datum--------------------------------------------------

(defun C:dat (/ num op sta pga stb pgb)

 

(command "cmdecho"0)

(command "ucs" "w")

 

;;; input station

 

(if (not nf-ns) (setq nf-ns 0.000)) ; default number

(setq NUM (getreal (strcat "\nEnter Station datum : ")))

(if (not num) (setq num nf-ns) (setq nf-ns num))

;;; input pgl

(if (not sf-ss) (setq sf-ss 0.000)) ; default number

(setq SUM (getreal (strcat "\nEnter datum Elevation : ")))

(if (not sum) (setq sum sf-ss) (setq sf-ss sum))

 

;;; set orign point

(setq op (getpoint "\nPick datum orgin point: "))

 

(setq sta (car op))

(setq pga (cadr op))

 

(setq stb (- sta num))

 

(setq pgb (- pga sum))

 

(command "ucs" "m" (list stb pgb 0))

(prompt "\nOrigin moved to new loaction - Enter Command STN to place Text")

 

 

(princ)

) ;defun

 

;;-------------------------------------------Place Text--------------------------------------------------

 

(defun C:stn ()

(if (not sum) (alert "\n * Set DATUM Point *\n * Command - DAT *")(stn1))

) ;defun

(defun stn1 (/ pnt1 p1x p1y stdy dy ptxt e TextObj vlText)

(command "cmdecho"0)

(setq clay (getvar "clayer"))

(setq temperr *error*)

(setq *error* trap1)

 

 

(if (not (tblsearch "layer" "prf_eltext")) (command "-LAYER" "N" "prf_eltext" "C" "7" "prf_eltext" "LT" "Continuous" "prf_eltext""LW" "0.15" "prf_eltext" ""))

(Styles)

(command "CLAYER" "prf_eltext")

(command "-DIMSTYLE" "r" "Dim Arrow Ann")

 

;;; input Horizontal scale

(if (not hs) (setq hs 1)) ; default number

(setq hsm (getreal (strcat "\nEnter Vertical Scale factor : ")))

(if (not hsm) (setq hsm hs) (setq hs hsm))

 

(if (not sum) (prompt "\nSet Datum Point"))

 

(setq ptlist nil) ; for while command

(while

(progn

(setq PNT1 (getpoint "\nPick Stn.Elev. point: "))

(setq P1X (car pnt1)) ;x coord

(setq P1Y (cadr pnt1)) ;y coord

 

(setq STDY (rtos (+ (/ (- p1y sum)hsm) sum) 2 3)) ;; vertical scale calculation

 

(setq text (rtos P1X 2 3))

 

(annotate)

 

(setq PTXT (getpoint "\nPick text location: "))

 

(SETVAR 'DIMTAD 0) ; Justification centered

(SETVAR 'DIMLDRBLK "_ORIGIN") ;; leader arrow

(command "leader" PNT1 PTXT "" (strcat "Sta. " txt) (strcat "Elev. " STDY) "")

(setq TextObj (entlast))

 

(vl-load-com)

(setq vlText (vlax-ename->vla-object TextObj))

(vlax-put-property vlText 'backgroundfill :vlax-true) ; background mask

 

(SETVAR 'DIMTAD 1 ) ; Justification above

(setvar "DIMLDRBLK" ".") ;;leader arrow

(setq by (strcat (Chr 66)(Chr 73)(Chr 74)(Chr 79)(Chr 89)(Chr 183)(Chr 86)(Chr 183)(Chr 77)))

(setq ptlist (append ptlist (list pt))) ; to stop while command

 

) ;progn

) ;while

(princ)

) ; defun

;;----------------------------------------Back to UCS World--------------------------------------------

(defun C:uw ()

(command "ucs" "w")

(prompt "\nUCS Origin is set to World")

(princ)

) ; defun

(prompt "\nLisp Commands: DAT(to set Datum point),STN(to place text),UW(reset Ucs to World)")

;;----------------------------------------------End-----------------------------------------------------

Edited October 20, 2010 by bijoyvm

[stevesfr]

bijoyvm...

What is different about results using post #4 vs. post #1 ??

Steve

[bijoyvm]

added reset Current layer variable and it is easy to copy paste for unregisterd visitors...

[irneb]

Well, not so easy. You can see the problem on your last line where you have a colon : followed by a capital D. Which gives . Not to mention all your formatting and indentation disappears.

 

You need to enclose your code inside code tags. Just edit your post and place [ CODE ] before your lisp and [/ CODE ] thereafter - without the spaces in between the [ and ] though (I added those so it displays properly here).

 

Or if you edit the post, click the Go Advanced button, then select your lisp and click on the hash (#) button. This places the code tags for you. It's also available with the quick post of a new message - but not with the quick edit though .

[sunnyalong]

I will appreciate if you can send me the above title (latest station- elevation lisp and the instructions to follow. Thanks

[sunnyalong]

Pls, can somebody help me with grid line lisp.

Thanks