Author Topic: Engineering Site Grading question  (Read 15233 times)

0 Members and 1 Guest are viewing this topic.

MSTG007

  • Gator
  • Posts: 2601
  • I can't remeber what I already asked! I need help!
Engineering Site Grading question
« Reply #15 on: March 21, 2005, 07:18:01 AM »
cab,
Yup it still does it... I am on another machine at work. Still geting the same error as above
Civil3D 2020

CADaver

  • Guest
Engineering Site Grading question
« Reply #16 on: March 21, 2005, 07:46:37 AM »
I knew somebody (read that as CAB) would be able to tweak* it some.

Thanks, that's sweet.  

(*Tweak = Sow's Ear to Silk Purse)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Engineering Site Grading question
« Reply #17 on: March 21, 2005, 08:00:43 AM »
Try this, comment out the WIPEOUT entity & see if the block can be created. It is a function of
express tools and may not be supported in your setup. Do you have Express tools?

Code: [Select]
;    (entmake '((0 . "WIPEOUT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
;              (100 . "AcDbWipeout") (90 . 0) (10 0.0078125 -0.0859375 0.0) (11 0.625 0.0 0.0)
;              (12 0.0 0.625 0.0) (13 1.0 1.0 0.0) (70 . 7) (280 . 1)
;              (281 . 50) (282 . 50) (283 . 0) (71 . 2) (91 . 9) (14 -0.5 0.4625 0.0)
;              (14 -0.225 0.4625 0.0) (14 -0.225 0.5 0.0) (14 0.5 0.5 0.0) (14 0.5 0.225 0.0)
;              (14 -0.225 0.225 0.0) (14 -0.225 0.2625 0.0) (14 -0.5 0.2625 0.0) (14 -0.5 0.4625 0.0)))


Let me know what you find out.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

MSTG007

  • Gator
  • Posts: 2601
  • I can't remeber what I already asked! I need help!
Engineering Site Grading question
« Reply #18 on: March 21, 2005, 09:34:47 AM »
do you think you can make the block look similar to this

http://www.theswamp.org/lilly_pond/mstg007/SPOTgrade.dwg?nossi=1

I know the lisp actually draws the block opposed to the block already defined.

Thanks cab!

it works great now!
Civil3D 2020

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Engineering Site Grading question
« Reply #19 on: March 21, 2005, 10:15:30 AM »
Glad you like it.

Quote from: MSTG007
it works great now!

Did you have to remove the WIPEOUT to get it to work??

Quote from: MSTG007
do you think you can make the block look similar to this

Short answer is Yes, but you can use the previous routine that CADaver posted & replace
"ielev" with your block name, put it in the ACAD search path, remove the path string
and update the attributes strings to match your block.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Engineering Site Grading question
« Reply #20 on: March 21, 2005, 10:23:43 AM »
Here is another update:
Added code to detect Expresstools and ignore the WIPEOUT if ET is not be loaded.

Code: [Select]
;;=========================================================================================
;; Slope Tag  V1.2, 1989, '92
;;   Revised 03/19/2005 - CAB Version 2.1
;; by RBCulp - Falcon Design Services, Inc.
;;
;; NO RIGHTS RESERVED; Any and all content may reproduced by any method on any medium for any reason.
;; Please, feel free to use any part found useful, interesting, enlightening or entertaining.
;; If by some chance, someone wishes to be credited for this, go right ahead.
;;
;; Falcon Design Services (FDS) provides this program "as is" and with all faults.
;; FDS specifically disclaims any implied warranty of merchantability or fitness for a particular use.  
;; FDS does not warrant that the operation of the program will be uninterrupted or error free.
;;=========================================================================================
(defun c:sltag (/ scft nstelev nslope FIRSTPT PT1 PT2 distm dist1 nxtelev
                *error* save_sys_vars restore_sys_vars make_block $elev)
  ;;===============================================
  ;;         L o c a l   F u n c t i o n s        
  ;;===============================================
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    )   ; endif
    (restore_sys_vars); reset vars
  )


 
  ;; Function to save system variables in global variable
  (defun save_sys_vars (lst)
    (setq *sysvarlist* '())
    (repeat (length lst)
      (setq *sysvarlist* (append *sysvarlist* (list (list (car lst) (getvar (car lst))))))
      (setq lst (cdr lst))
    )
  )

  ;; Function to reset system variables
  (defun restore_sys_vars ()
    (repeat (length *sysvarlist*)
      (setvar (caar *sysvarlist*) (cadar *sysvarlist*))
      (setq *sysvarlist* (cdr *sysvarlist*))
    )
  )


  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ;;           Make the elevation tag block        
  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  (defun make_block(blockname / et)
    ;;  Check for ExpressTools
    (if (member "acetutil.arx" (arx))
(if (wcmatch (getvar "ACADVER") "*16*")
           (or (not (arxload "acwipeout")) (setq et T))
           (or (not(member "wipeout.arx" (arx)))(setq et T))
)
    )

    (if (not et)
       (alert "Express Tools are not Loaded \n Tag will be 'See Through'")
    )

    ;;==============================================
    ;;       Start of Block definition              
    ;;==============================================
    (entmake
      (list '(0 . "BLOCK")            ; required
            '(100 . "AcDbEntity")     ; recommended
            '(100 . "AcDbBlockBegin") ; recommended
            (cons 2 blockname)        ; required
            '(8 . "0")                ; recommended
            '(70 . 2)                 ; required [NOTE 0 if no attributes]
            '(10 0.0 0.0 0.0)         ; required
      )
    )
   
    ;;==============================================
    ;;            Block objects                    
    ;;==============================================
    ;; NOTE: Wipeouts must be created first for other objects to be visable
    (if et
    (entmake '((0 . "WIPEOUT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbWipeout") (90 . 0) (10 0.0078125 -0.0859375 0.0) (11 0.625 0.0 0.0)
              (12 0.0 0.625 0.0) (13 1.0 1.0 0.0) (70 . 7) (280 . 1)
              (281 . 50) (282 . 50) (283 . 0) (71 . 2) (91 . 9) (14 -0.5 0.4625 0.0)
              (14 -0.225 0.4625 0.0) (14 -0.225 0.5 0.0) (14 0.5 0.5 0.0) (14 0.5 0.225 0.0)
              (14 -0.225 0.225 0.0) (14 -0.225 0.2625 0.0) (14 -0.5 0.2625 0.0) (14 -0.5 0.4625 0.0)))
    )
    (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbText")
              (10 0.279583 -0.05 0.0) (40 . 0.1) (1 . "") (50 . 0.0) (41 . 0.7) (51 . 0.0)
              (7 . "Standard") (71 . 0) (72 . 1) (11 0.40625 0.0 0.0) (210 0.0 0.0 1.0)
              (100 . "AcDbAttributeDefinition") (3 . "ELEV....") (2 . "ELEV") (70 . 0)
              (73 . 0) (74 . 2)))
    (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0)
              (10 0.183594 -0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 -0.0789062)
              (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 0.0789062) (40 . 0.0) (41 . 0.0)
              (42 . 0.0) (10 0.183594 0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0)))
    (entmake '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbText") (10 0.00806548 -0.05 0.0) (40 . 0.1) (1 . "I.E.") (50 . 0.0)
              (41 . 0.8) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 2) (11 0.171875 0.0 0.0)
              (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2)))
 
    ;;==============================================
    ;;     This is the end of block marker          
    ;;==============================================
    (entmake (list '(0 . "ENDBLK")         ; required
                   '(100 . "AcDbBlockEnd") ; recommended
                   '(8 . "0")              ; recommended
                   ))
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ) ;                 end defun make_block            
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_

 
  ;;************************************************************************
  ;;************************************************************************
  ;;                    S T A R T   O F   R O U T I N E                    
  ;;************************************************************************
  ;;************************************************************************

  ;;------------------------------------------------------------------------
  ;;    Set defaults on first use
  ;;------------------------------------------------------------------------
  (or *stelev* (setq *stelev* 1200.00))
  (or *slope*  (setq *slope*  -0.002))
  (if (not (setq *units*
              (car(member *units* '("Inch" "Foot" "Meter" "Centimeter")))))
    (progn
      (initget "Inch Foot Meter Centimeter")
      (setq *units*
             (getkword
               "\nOne Unit in this drawing = [Inch/Foot/Meter/Centimeter] <Inch>:"))
      (or *units* (setq *units* "Inch"))
    )
  )
  ;;------------------------------------------------------------------------
 
  (save_sys_vars '("CMDECHO" "attdia" "attreq" "texteval"))
  (command ".undo" "begin")
 
  (setvar "cmdecho"  0)
  (setvar "attdia"   0)
  (setvar "attreq"   1)
  (setvar "texteval" 1)
 
  (setq scft  (getvar "dimscale")
        tunit (getvar "lunits")
        distm 0)
    ;;  ????????????????????
  (cond
    ((= 2 tunit)
      (setq tprec 3)
    )
    ((= 4 tunit)
      (setq tprec 4)
    )
    (T
      (setq tprec 3)
    )
  ) ; ?????????????????????
 
  ;;------------------------------------------------------------------------
  (if (and (not (tblsearch "Block" "Ielev"))
           (not (make_block "Ielev")))
    (progn
      (alert "Make Block Failed, can not continue.")
      (exit)
    )
  )
 
 (if (and
        (or (not (setq nstelev
             (getdist (strcat "Enter Starting Elevation <" (RTOS *stelev*) ">: "))))
           (setq *stelev* nstelev))
        (or (not (setq nslope (getreal (strcat "Enter Slope Factor (Negative For Down) <"
                                    (RTOS *slope* 2 8)  ">: " ))))
            (setq *slope* nslope))
        (setq FIRSTPT (getpoint "Select Starting point "))
        (setq pt1     firstpt
              nxtelev *stelev*)
      ) ; and

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    (while (setq PT2 (getpoint PT1 "\n\nNext point "))
     
      (setq dist1   (distance pt1 pt2)
            distm   (+ distm dist1)
            nxtelev (+ (* dist1 *slope*) nxtelev)
            PT1 PT2
      )
      (princ (strcat "\n                        Distance is  " (rtos dist1)))
      (princ (strcat "\n                           Slope is  "
                     (rtos (* dist1 *slope*))))
      (princ (strcat "\n                       Elevation is  "
                     (rtos nxtelev tunit tprec)))
      (princ (strcat "\n          Running Total Distance is  " (rtos distm)))
      ;;------------------------------------------------------------------------
      (if (= *units* "Inch") ; convert to feet
        (setq $elev (rtos (/ nxtelev 12.0) 2 2))
        (setq $elev (rtos nxtelev 2 2))
      )
      (if (or (eq *units* "Inch") (eq *units* "Foot"))
        (setq $elev (strcat $elev "'"))
      )
       
      (command "-insert" "Ielev" "s" scft "r" "45" pt2 $elev)
      ;;------------------------------------------------------------------------
    ) ; end while
    ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ); endif

  (princ (strcat "\n\n          Final Total Distance is  " (rtos distm)))

  (command ".undo" "end")
                 
  (*error* "") ; restore variables
 
  (princ)
)
(prompt "\n***   Slope Tag Loaded, Enter sltag to run.  ***")
(princ)
;;=========================================================================================
;;  eof
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Engineering Site Grading question
« Reply #21 on: March 21, 2005, 11:23:47 AM »
Here is yet another version based on the scenario CarlB posted.
See the picture below to illustrate.
ST PT 1 is the very first point chosen and elevation set at 100'
points were the chosen along the RED arrow to show slope along the
house foundation.
ST PT 2 is chosen using the NEW option. The new start point elevation is
99.97' based on distance Stpt1 to stpt2. Then points are added along the
green arrow showing slope in that direction.
ST PT 3 is chosen using the NEW option. The new start point elevation is
99.94' based on distance Stpt2 to stpt3. Then points are added along the
cyan arrow showing slope in that direction.



Code: [Select]
;;=========================================================================================
;; Slope Tag  V1.2, 1989, '92
;;   Revised 03/19/2005 - CAB
;;   Revised 03/21/2005 - CAB Version 2.1
;;     all elev are calc for start point, you may reset the start point
;;     new start point elev is based on the previous start point elevation
;; by RBCulp - Falcon Design Services, Inc.
;;
;; NO RIGHTS RESERVED; Any and all content may reproduced by any method on any medium for any reason.
;; Please, feel free to use any part found useful, interesting, enlightening or entertaining.
;; If by some chance, someone wishes to be credited for this, go right ahead.
;;
;; Falcon Design Services (FDS) provides this program "as is" and with all faults.
;; FDS specifically disclaims any implied warranty of merchantability or fitness for a particular use.  
;; FDS does not warrant that the operation of the program will be uninterrupted or error free.
;;=========================================================================================
(defun c:sltag2 (/ scft stelev nstelev nslope FIRSTPT PT1 PT2 distm dist1 nxtelev
                *error* save_sys_vars restore_sys_vars make_block $elev)
  ;;===============================================
  ;;         L o c a l   F u n c t i o n s        
  ;;===============================================
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    )   ; endif
    (restore_sys_vars); reset vars
  )


 
  ;; Function to save system variables in global variable
  (defun save_sys_vars (lst)
    (setq *sysvarlist* '())
    (repeat (length lst)
      (setq *sysvarlist* (append *sysvarlist* (list (list (car lst) (getvar (car lst))))))
      (setq lst (cdr lst))
    )
  )

  ;; Function to reset system variables
  (defun restore_sys_vars ()
    (repeat (length *sysvarlist*)
      (setvar (caar *sysvarlist*) (cadar *sysvarlist*))
      (setq *sysvarlist* (cdr *sysvarlist*))
    )
  )


  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ;;           Make the elevation tag block        
  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  (defun make_block(blockname / et)
    ;;  Check for ExpressTools
    (if (member "acetutil.arx" (arx))
(if (wcmatch (getvar "ACADVER") "*16*")
           (or (NOT (arxload "acwipeout")) (setq et T))
           (or (not(member "wipeout.arx" (arx)))(setq et T))
)
    )

    (if (not et)
       (alert "Express Tools are not Loaded \n Tag will be 'See Through'")
    )
    ;;==============================================
    ;;       Start of Block definition              
    ;;==============================================
    (entmake
      (list '(0 . "BLOCK")            ; required
            '(100 . "AcDbEntity")     ; recommended
            '(100 . "AcDbBlockBegin") ; recommended
            (cons 2 blockname)        ; required
            '(8 . "0")                ; recommended
            '(70 . 2)                 ; required [NOTE 0 if no attributes]
            '(10 0.0 0.0 0.0)         ; required
      )
    )
   
    ;;==============================================
    ;;            Block objects                    
    ;;==============================================
    ;; NOTE: Wipeouts must be created first for other objects to be visable
    (if et
    (entmake '((0 . "WIPEOUT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbWipeout") (90 . 0) (10 0.0078125 -0.0859375 0.0) (11 0.625 0.0 0.0)
              (12 0.0 0.625 0.0) (13 1.0 1.0 0.0) (70 . 7) (280 . 1)
              (281 . 50) (282 . 50) (283 . 0) (71 . 2) (91 . 9) (14 -0.5 0.4625 0.0)
              (14 -0.225 0.4625 0.0) (14 -0.225 0.5 0.0) (14 0.5 0.5 0.0) (14 0.5 0.225 0.0)
              (14 -0.225 0.225 0.0) (14 -0.225 0.2625 0.0) (14 -0.5 0.2625 0.0) (14 -0.5 0.4625 0.0)))
    )
    (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbText")
              (10 0.279583 -0.05 0.0) (40 . 0.1) (1 . "") (50 . 0.0) (41 . 0.7) (51 . 0.0)
              (7 . "Standard") (71 . 0) (72 . 1) (11 0.40625 0.0 0.0) (210 0.0 0.0 1.0)
              (100 . "AcDbAttributeDefinition") (3 . "ELEV....") (2 . "ELEV") (70 . 0)
              (73 . 0) (74 . 2)))
    (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0)
              (10 0.183594 -0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 -0.0789062)
              (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 0.0789062) (40 . 0.0) (41 . 0.0)
              (42 . 0.0) (10 0.183594 0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0)))
    (entmake '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbText") (10 0.00806548 -0.05 0.0) (40 . 0.1) (1 . "I.E.") (50 . 0.0)
              (41 . 0.8) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 2) (11 0.171875 0.0 0.0)
              (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2)))
 
    ;;==============================================
    ;;     This is the end of block marker          
    ;;==============================================
    (entmake (list '(0 . "ENDBLK")         ; required
                   '(100 . "AcDbBlockEnd") ; recommended
                   '(8 . "0")              ; recommended
                   ))
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ) ;                 end defun make_block            
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_

 
  ;;************************************************************************
  ;;************************************************************************
  ;;                    S T A R T   O F   R O U T I N E                    
  ;;************************************************************************
  ;;************************************************************************

  ;;------------------------------------------------------------------------
  ;;    Set defaults on first use
  ;;------------------------------------------------------------------------
  (or *stelev* (setq *stelev* 1200.00))
  (or *slope*  (setq *slope*  -0.002))
  (if (not (setq *units*
              (car(member *units* '("Inch" "Foot" "Meter" "Centimeter")))))
    (progn
      (initget "Inch Foot Meter Centimeter")
      (setq *units*
             (getkword
               "\nOne Unit in this drawing = [Inch/Foot/Meter/Centimeter] <Inch>:"))
      (or *units* (setq *units* "Inch"))
    )
  )
  ;;------------------------------------------------------------------------
 
  (save_sys_vars '("CMDECHO" "attdia" "attreq" "texteval"))
  (command ".undo" "begin")
 
  (setvar "cmdecho"  0)
  (setvar "attdia"   0)
  (setvar "attreq"   1)
  (setvar "texteval" 1)
 
  (setq scft  (getvar "dimscale")
        tunit (getvar "lunits")
        distm 0)
    ;;  ????????????????????
  (cond
    ((= 2 tunit)
      (setq tprec 3)
    )
    ((= 4 tunit)
      (setq tprec 4)
    )
    (T
      (setq tprec 3)
    )
  ) ; ?????????????????????
 
  ;;------------------------------------------------------------------------
  (if (and (not (tblsearch "Block" "Ielev"))
           (not (make_block "Ielev")))
    (progn
      (alert "Make Block Failed, can not continue.")
      (exit)
    )
  )
 
 (if (and
        (or (not (setq nstelev
             (getdist (strcat "Enter Starting Elevation <" (RTOS *stelev*) ">: "))))
           (setq *stelev* nstelev))
        (or (not (setq nslope (getreal (strcat "Enter Slope Factor (Negative For Down) <"
                                    (RTOS *slope* 2 8)  ">: " ))))
            (setq *slope* nslope))
        (setq pt1 (getpoint "Select Starting point "))
        (setq stelev *stelev*)
      ) ; and

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    (while (or
              (initget "New")
              (setq PT2 (getpoint PT1 "\n\nNext point or New point "))
           ) ;end or

    (cond
      ((listp PT2); Is PT a point list?
      (setq dist1   (distance pt1 pt2)
            nxtelev (+ (* dist1 *slope*) stelev)
      )
      (princ (strcat "\n                        Distance is  " (rtos dist1)))
      (princ (strcat "\n                           Slope is  "
                     (rtos (* dist1 *slope*))))
      (princ (strcat "\n                       Elevation is  "
                     (rtos nxtelev tunit tprec)))
      ;;------------------------------------------------------------------------
      (if (= *units* "Inch") ; convert to feet
        (setq $elev (rtos (/ nxtelev 12.0) 2 2))
        (setq $elev (rtos nxtelev 2 2))
      )
      (if (or (eq *units* "Inch") (eq *units* "Foot"))
        (setq $elev (strcat $elev "'"))
      )
       
      (command "-insert" "Ielev" "s" scft "r" "45" pt2 $elev)
       )
      (T ; new start point based on base elevation
        (while
          (not (setq pt2 (getpoint pt1 "\n>>--> Select New Starting point: ")))
          (princ "\nPlease try again..."))
        (setq dist1   (distance pt1 pt2)
              stelev  (+ (* dist1 *slope*) stelev)
              pt1     pt2
        )

      )
     ) ; end cond stmt
      ;;------------------------------------------------------------------------
    ) ; end while
    ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ); endif

  (command ".undo" "end")
                 
  (*error* "") ; restore variables
 
  (princ)
)
(prompt "\n***   Slope Tag Loaded, Enter sltag2 to run.  ***")
(princ)
;;=========================================================================================
;;  eof
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

danny

  • Guest
Engineering Site Grading question
« Reply #22 on: March 21, 2005, 12:24:45 PM »
CAB,
I get an error message
Code: [Select]
make block failed, cannot continue

CADaver

  • Guest
Engineering Site Grading question
« Reply #23 on: March 21, 2005, 12:34:16 PM »
Just so you know, I just noticed the ????? in your tweaked code.  
Code: [Select]
(setq scft  (getvar "dimscale")
        tunit (getvar "lunits")
        distm 0)
    ;;  ????????????????????
  (cond
    ((= 2 tunit)
      (setq tprec 3)
    )
    ((= 4 tunit)
      (setq tprec 4)
    )
    (T
      (setq tprec 3)
    )
  ) ; ?????????????????????
I was in the process of tweaking the code a couple years ago, and I was gonna read LUNITS to determine whether we were in a FT-IN file or a FT-DEC.  Then I was gonna do the calcs and set the attribute value precision based on that.
Code: [Select]
(rtos nxtelev tunit tprec))) Since then, we changed our standard such that ALL site elevations are FT-DEC to 2 places.

CADaver

  • Guest
Engineering Site Grading question
« Reply #24 on: March 21, 2005, 12:37:39 PM »
BTW, why don't you go ahead and fix the rest of the code and take my header (such as it is) off all together.   :wink:  That's pretty sweet coding, dood.  Do you have a real job???

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Engineering Site Grading question
« Reply #25 on: March 21, 2005, 01:59:58 PM »
Quote from: danny
CAB,
I get an error message
** make block failed, cannot continue

Sorry about that.
What version of Autocad are you running and do you have Expresstools loaded?
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

danny

  • Guest
Engineering Site Grading question
« Reply #26 on: March 21, 2005, 02:11:00 PM »
no need to be sorry.....
the version I tested it in was ACAD2004, and express tools was loaded. :?

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Engineering Site Grading question
« Reply #27 on: March 21, 2005, 07:39:07 PM »
danny,
recopy the routines above, I updated both of them.
It is the WIPEOUT that is giving me a problem and detecting express tools.
In ACAD2000 when acetutil.arx is loaded the wipeout.arx is also loaded so
all is well, but in ACAD2004 acetutil.arx may be loaded and acwipeout.arx
is not always loaded and the name of the routine is changed.
Therefore a more elaborate detection algorithm was needed. I don't have
ACAD R14 or 2002 or 2005 so I can't test these.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Engineering Site Grading question
« Reply #28 on: March 21, 2005, 07:55:29 PM »
Quote from: CADaver
Do you have a real job???

No :) , if i did they would fire me or take away my IE connection.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CADaver

  • Guest
Engineering Site Grading question
« Reply #29 on: March 21, 2005, 08:06:01 PM »
Quote from: CAB
Quote from: CADaver
Do you have a real job???

No :) , if i did they would fire me or take away my IE connection.


Do you want one?

...

no, wait a minute...

...

they find out they really don't need me...

...

nevermind.