HEllo,
I ran across this grating lisp file online. I tried to use it but there is an error in it. If someone can take a look at it and I would appreciate it.
;GRADING.LSP (C:TAG)
;--------------------------------------
;This routine is used mainly on grading plans to show elevations of
;certain features like back-of-curb, valley gutters, etc. . .
;The AutoCAD variable LTSCALE determines the size of the tags.
;
;Four different types of elevation tags are available. Single tags
;show an elevation over a description. Double tags show two elevations
;i.e. 2100.39 TC \ 2099.89 AC. Box tags show a single elevation with
;a box around it. Longbox tags show a single elevation with a longer
;box to allow a decrtiption as well.
;
;The leader lines can either be fixed or variable. Fixed leaders are
;part of the elevation tag block and are therefore easier to move, copy
;or erase later. Variabl leaders are not part of the block and are use-
;ful in tight spaces.
;
;You have the option of inserting a point block that can be used by rou-
;tines in other civil software packages such as Softdesk's AdCADD pack-
;ages. This point block is inserted along with the elevation tag. The
;elevation of the point will be determined from the value of the elev-
;ation tag. Tagging from points will allow you to insert elevation tags
;at the insertion points of existing point blocks and using their values
;for the elevation and description of the tag.
;
;The blocks with the `GT' prefix (i.e. GTBF1.DWG) and the POINT.DWG are
;used by this routine.
;
(defun getatt (blkent atttag / blked entype attval atag)
(setq blked (entget blkent)
entype (cdr (assoc 0 blked))
attval nil
)
(if (= entype "INSERT")
(while (/= entype "SEQEND")
(setq blkent (entnext blkent)
blked (entget blkent)
entype (cdr (assoc 0 blked))
atag (cdr (assoc 2 blked))
)
(if (= atag atttag)
(setq attval (cdr (assoc 1 blked))
entype "SEQEND"
) ) )
(prompt "\nEntity selected is not a block.")
)
attval
)
(defun putatt (blkent atttag attval / blked entype putokay atag oldval newval)
(setq blked (entget blkent)
entype (cdr (assoc 0 blked))
putokay 0
)
(if (= entype "INSERT")
(while (/= entype "SEQEND")
(setq blkent (entnext blkent)
blked (entget blkent)
entype (cdr (assoc 0 blked))
atag (cdr (assoc 2 blked))
)
(if (= atag atttag)
(progn
(setq oldval (assoc 1 blked)
newval (cons 1 attval)
blked (subst newval oldval blked)
entype "SEQEND"
putokay -1
)
(entmod blked)
(entupd (cdr (assoc -1 blked)))
) ) )
(prompt "\nEntity selected is not a block.")
)
putokay
)
(defun kent (kwd msg def / inp)
(setq msg (strcat "\n" msg " (" kwd ") <" def ">: ")
oldos (getvar "OSMODE")
)
(setvar "OSMODE" 1536)
(initget kwd)
(setq inp (getpoint msg))
(setvar "OSMODE" oldos)
(cond
((= (type inp) 'STR) inp)
((= (type inp) 'LIST)
(if (setq ss (ssget inp))
(ssname ss 0)
nil
) )
((not inp) def)
) )
(defun kword (bit kwd msg def / inp)
(if (and def (/= def ""))
(setq msg (strcat "\n" msg " (" kwd ") <" def ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg " (" kwd "): "))
)
(initget bit kwd)
(setq inp (getkword msg))
(if inp inp def)
)
(defun kstr (bit msg def spflag / inp nval)
(if (and def (/= def ""))
(setq msg (strcat "\n" msg " <" def ">: ")
inp (getstring msg spflag)
inp (if (= inp "") def inp)
)
(progn
(setq msg (strcat "\n" msg ": "))
(if (= bit 1)
(while (= "" (setq inp (getstring msg spflag))))
(setq inp (getstring msg spflag))
) )
)
inp
)
(defun kpoint (bit kwd msg def bpt / inp)
(if def
(setq pts (strcat (rtos (car def)) "," (rtos (cadr def))
(if (and (caddr def) (= 0 (getvar "FLATLAND")))
(strcat "," (rtos (caddr def)))
""
) )
msg (strcat "\n" msg " (" kwd ") <" pts ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg " (" kwd "): "))
)
(initget bit kwd)
(setq inp
(if bpt
(getpoint msg bpt)
(getpoint msg)
) )
(if inp inp def)
)
(defun setquad (ldrang)
(cond
((and (>= ldrang 0) (< ldrang (/ PI 2)))
"1"
)
((and (>= ldrang (/ PI 2)) (< ldrang PI))
"4"
)
((and (>= ldrang PI) (< ldrang (* PI 1.5)))
"3"
)
((and (>= ldrang (* PI 1.5)) (< ldrang (* PI 2.0)))
"2"
) ) )
(defun stag (inspt tagtype ldrtype autocode CHC_PTH)
(setq pt2 (getpoint inspt "\nSecond point")
ldrang (angle inspt pt2)
quadrant (setquad ldrang)
)
(if (= tagtype "Single")
(setq pretag (CHC_PTH "L:/BLOCKS/GT")
udef "0000.00"
ldef "T.C."
)
(setq pretag (CHC_PTH "L:/BLOCKS/GTD")
udef "0000.00 T.C."
ldef "0000.00 A.C."
)
)
(if (not autocode)
(setq uval (kstr 0 "Upper tag value" udef T)
lval (kstr 0 "Lower tag value" ldef T)
) )
(command ".UNDO" "M")
(if (and (= dopoint "Yes") (not autocode))
(progn
(command ".INSERT" (CHC_PTH "L:/BLOCKS/POINT") "S" (getvar "LTSCALE") inspt blkang uval ptnum lval)
(setq ptnum (1+ ptnum))
) )
(if (= ldrtype "Fixed")
(command ".INSERT" (strcat pretag "F" quadrant) "S" (getvar "LTSCALE") inspt blkang uval lval)
(progn
(command ".DONUT" 0.0 (* 0.03 (getvar "LTSCALE")) inspt "")
(command ".LINE" inspt pt2 "")
(if (or (= quadrant "1") (= quadrant "2"))
(setq tagblk (strcat pretag "R"))
(setq tagblk (strcat pretag "L"))
)
(command ".INSERT" tagblk "S" (getvar "LTSCALE") pt2 blkang uval lval)
) ) )
(defun boxtag (inspt ldrtype)
(setq pt2 (getpoint inspt "Second point")
ldrang (angle inspt pt2)
uval (kstr 0 "Box tag value" "000.00" T)
quadrant (setquad ldrang)
)
(if (= tagtype "Longbox")
(setq pretag (CHC_PTH "L:/BLOCKS/"))
(setq pretag (CHC_PTH "L:/BLOCKS/"))
)
(command ".UNDO" "M")
(if (= dopoint "Yes")
(progn
(command ".INSERT" (CHC_PTH "L:/BLOCKS/POINT") "S" (getvar "LTSCALE") inspt blkang uval ptnum lval)
(setq ptnum (1+ ptnum))
) )
(if (= ldrtype "Fixed")
(command ".INSERT" (strcat pretag "f" quadrant) "S" (getvar "LTSCALE") inspt blkang uval)
(progn
(command ".DONUT" (* 0.0 (getvar "LTSCALE")) (* 0.03 (getvar "LTSCALE")) inspt "")
(command ".LINE" inspt pt2 "")
(setq tagblk (strcat pretag quadrant))
(command ".INSERT" tagblk "S" (getvar "LTSCALE") pt2 blkang uval)
) ) )
(defun tagpnts ( / exitcode en ptent inspt uval lval)
(setq exitcode nil
desctype (kword 0 "User Desc" "User defined or point descriptions" "User")
)
(while (not exitcode)
(setq en (kent "Undo Multiple Leader Tags" "Pick a point block" "Tags"))
(cond
((= en "Multiple")
(multipt)
)
((= en "Leader")
(setq ldrtype (kword 0 "Fixed Variable" "Leader type" "Fixed"))
)
((= en "Tags")
(setq exitcode 1)
)
((= en "Undo")
(command ".UNDO" "B")
)
(en
(if (setq uval (getatt en "ELEV"))
(progn
(setq ptent (entget en)
inspt (cdr (assoc 10 ptent))
)
(if (= desctype "User")
(setq lval (kstr 0 "Tag Description" "T.C." T))
(setq lval (getatt en "DESC"))
)
(stag inspt "Single" ldrtype 1)
)
(prompt " Try again.")
) ) ) ) )
(defun multipt ( / ptss numpts count blkn ed inspt uval lval)
(prompt "\nSelect grading points: ")
(setq ptss (ssget)
numpts (sslength ptss)
count 0
)
(if (> numpts 0)
(while (< count numpts)
(setq blkn (ssname ptss count)
ed (entget blkn)
inspt (cdr (assoc 10 ed))
)
(if (and (= (cdr (assoc 0 ed)) "INSERT")
(= (cdr (assoc 2 ed)) "POINT")
(setq uval (getatt blkn "ELEV"))
)
(progn
(if (= desctype "User")
(setq lval (kstr 0 "Tag Description" "T.C." T))
(setq lval (getatt blkn "DESC"))
)
(stag inspt "Single" ldrtype 1)
) )
(setq count (1+ count))
) ) )
(defun C:TAG ()
(command ".UNDO" "M")
(setq blkang (angtos (getvar "SNAPANG") (getvar "AUNITS") (getvar "AUPREC")))
(if (not ldrtype)
(setq ldrtype "Variable"
tagtype "Single"
) )
(setq dopoint (kword 0 "Yes No" "Do you want grading points inserted" "No")
)
(if (or (not ptnum) (/= (type ptnum) 'INT))
(setq ptnum 1)
)
(while (setq inspt (kpoint 0 "Points Leader Type Undo" "Insertion point" nil nil))
(cond
((= inspt "Leader")
(setq ldrtype (kword 0 "Fixed Variable" "Leader Type" "Variable"))
)
((= inspt "Points")
(tagpnts)
)
((= inspt "Type")
(setq tagtype (kword 0 "Single Double Box Longbox" "Tag Type" "Single"))
)
((= inspt "Undo")
(command ".UNDO" "B")
)
(inspt
(if (or (= tagtype "Single") (= tagtype "Double"))
(stag inspt tagtype ldrtype nil)
(boxtag inspt ldrtype)
) ) )
)
(princ)
)
