Author Topic: Grating Lisp that needs help  (Read 817 times)

0 Members and 1 Guest are viewing this topic.

laisonalbarado

  • Mosquito
  • Posts: 2
Grating Lisp that needs help
« on: November 05, 2018, 01:11:23 PM »
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)
)

Master_Shake

  • Swamp Rat
  • Posts: 1447
Re: Grating Lisp that needs help
« Reply #1 on: November 05, 2018, 02:26:48 PM »
What is the error?

laisonalbarado

  • Mosquito
  • Posts: 2
Re: Grating Lisp that needs help
« Reply #2 on: November 07, 2018, 09:50:38 AM »
I don't have a clue.

ronjonp

  • Needs a day job
  • Posts: 7168
Re: Grating Lisp that needs help
« Reply #3 on: November 07, 2018, 11:57:59 AM »
Do you have the blocks?
Quote
;The blocks with the `GT' prefix (i.e. GTBF1.DWG) and the POINT.DWG are
;used by this routine.

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

Master_Shake

  • Swamp Rat
  • Posts: 1447
Re: Grating Lisp that needs help
« Reply #4 on: November 07, 2018, 12:50:55 PM »
I don't have a clue.

When you run the lisp routine, what does the AutoCAD command prompt say?