Topic: Help make a routine better

[bman]

How can this routine be modified to prompt for either a real number or by selecting an entity for both the upper & lower elevations?
.....ie, "Enter a starting elevation: <Enter to pick text>"

Code: [Select]

(defun c:Slo (/ ocmd ent1 uelev lelev lng1 txts ang1)
(command "_.undo" "_end")
(command "_.undo" "_group")
(setq clay (getvar "clayer"))
(setq ocmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ent1 (entsel "\nSelect upper elevation: "))
(if ent1
(progn
(setq ent1 (makex (car ent1)))
(setq uelev (getx ent1 'TextString))
)
)
(setq ent1 (entsel "\nSelect lower elevation: "))
(if ent1
(progn
(setq ent1 (makex (car ent1)))
(setq lelev (getx ent1 'TextString))
)
)
(setvar "osmode" 617)
;;;;;;;;;;;(command "-layer" "s" "dra-breakline" "")
(prompt "\nEnter point(s): ")
(command "_.pline")
(while (> (getvar "cmdactive") 0)
(command pause)
)
(setq ent1 (makex (entlast)))
(setq lng1 (getx ent1 'Length))
(if (and uelev lelev lng1)
(progn
(setq txts (* (/ (- (atof uelev) (atof lelev)) lng1) 100))
(setq ang1
(rtd
(angle
(getpoint "\nSelect slope label angle (going left to right). ")
(getpoint "\nSelect end point of angle. ")
)
)
)
(prompt "\nSelect insertion point of slope text: ")
(if (> (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0)
(command "_text" "j" "bc" pause ang1 (strcat(rtos txts 2 2)"%"))
(command "_text" "j" "bc" pause "" ang1 (strcat(rtos txts 2 2)"%"))
)
)
)
(command "-layer" "s" clay "")
(setvar "cmdecho" ocmd)
(command "_.undo" "_end")
(princ)
)

[Peter Jamtgaard]

Try this sub for getting the textstring from a text object or entering text.

Peter Jamtgaard

Code: [Select]


(defun GetElevation (strPrompt / entSelection lstEntity lstPair osmode sngElevation strElevation )
 (while (not sngElevation)
  (initget 128)
  (if (setq strElevation (getpoint strPrompt))
   (cond ((= (type strElevation) 'STR)
          (setq sngElevation (atof strElevation))
         )        
         ((= (type strElevation) 'LIST)        
          (if (and (setq lstPair (nentselp "" strElevation))
                   (setq entSelection (car lstPair))
                   (setq lstEntity    (entget entSelection))
                   (assoc 1 lstEntity)
                   (setq strElevation (cdr (assoc 1 lstEntity)))
              )
           (setq sngElevation (atof strElevation))
           (princ "\nError: Textnot found: ")
          )
         )
   )
  )
 )
 sngElevation
)