[编程交流] 标高标记

[color="red"][EDIT] in red[/color]
*IL:shx* *IL:user* ;global variables
(defun c:[color="red"]ILM[/color] (/ *error* v var p0 u1 u2 tmp shx f ip sz [color="red"]str[/color]); [color="red"]Invert level[/color] elevation marker
;hanhphuc 25/10/2014
(if (not(findfile (setq shx (strcat(getvar "tempprefix") "IL.shx"))))
(progn  (setq f (open (setq tmp (strcat(getvar "tempprefix") "IL.shp")) "W"))
(foreach x 
'("*1,42,IL"
"4,250,4,4,3,107,3,37,3,28,002,9,(0,0),001,9,(64,111),(-127,0),(-1,0),(64,-111),(0,0),002,9,(0,0),001,4,28,4,37,4,107,3"
"4,3,250,0")
(write-line x f))
(close f)
(command "compile" tmp)
)
); if
(if (and (not *IL:shx* ) shx)
(setq *IL:shx* (vl-cmdf "load" shx)))
 
(mapcar 'set '( v str *error*  var)
(list '( "osmode" "cmdecho" "dimzin")'("\nRef. station?" "Datum?" "Textsize?" )
'((msg) (if(not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
             (princ (strcat "\nError: " msg)))(princ))                   
                    (mapcar 'getvar v )))
(foreach x v (setvar x 0))
 
[color="gray"];;;  OP's quoted : " my datum is 594, invert level is 600.23, on station 0+321 "[/color] [color="gray"]so set as default value..
[/color]
(setq *IL:user* (if (vl-every 'not *IL:user*) '((0. [color="blue"]594.[/color] 1.) ([color="blue"]321. 600.23[/color])) (list (car *IL:user*) (cadr *IL:user*))))                 
(if (and (setq p0 (getpoint "\nPick reference point.."))
 (setq u1 (hp# 'getreal '(0 0 6) str (car *IL:user*)))
 ) ;_ end of and
(progn
(prompt
(vl-string-translate "?" ":"
(apply 'strcat (mapcar ''((a b )(strcat a (rtos b 2 2))) str (car *IL:user*)))))
(textpage)
(while (if (and        (setq u2 (hp# 'getreal '(0 0) '("\nInput STA?" "Invert Level?") (cadr *IL:user*)))
        (setq *IL:user* (list u1 u2))
        (setq ip (mapcar '+ p0 (mapcar '- u2 u1)))
        ) ;_ end of and
 (progn
         (setq sz (caddar *IL:user*))
   (vl-cmdf "shape" "IL" ip sz 0.0)
        (entmakex (list        '(0 . "TEXT")
                        (cons 1 (strcat "IL" (rtos (cadadr *IL:user*) 2 2)))
                        (cons 40 sz )
                        (cons 10 (polar ip (/ pi 4.) (* 1.4121 sz )))
                        ) ;_ end of list
                  ) ;_ end of entmakex
        ) ;_ end of progn
 ) ;_ end of if
) ;_ end of while
 )
 ) ;_ end of if
 (mapcar 'setvar v var)
 (princ)
)
;; courtesy of the author's of "Inside AutoLisp"                
;; for rel. 10 published by New Riders Publications                 
;; Referenced to the concept of UREAL UKWORD,                        
;;;HP# ; user prompt for numbers  by hanhphuc 2014
 (defun hp# (_f _ini _msg _def  / usr l)
 (if (and(member _f '(getreal getint getdist))
         (vl-every '(lambda (x) (= (type x) 'INT)) _ini )
  )
   (progn (setq usr (mapcar '(lambda (i a b) (initget i) ((eval _f) (strcat a " < "(rtos b 2 2) " > : ")))
                     _ini
                     _msg
                     _def
                     ) ;_ end of mapcar
         ) ; setq
   (while usr
     (setq l (cons (if (null (car usr))
                        (car _def)
                        (car usr)
                        ) ;_ end of if
                      l
                      ) ;_ end of cons
           usr        (cdr usr)
           _def        (cdr _def)
           ) ;_ end of setq
     l
     ) ;_ end of while
   (reverse l)
   ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of defun