AT:MText AT:ToStation
AT:Sta2Num AT:AngleAtPoint
_getstring _Setup
e s
p o
)
;; Find and label station along alignment (with option to perform offset)
;; Alan J. Thompson, 11.04.10
;; rev kdub: _Setup added kdub@theSwamp
;; rev kdub: Add Points, TextSize TextColor and modify station Text. 2014.03.16
(defun _setup
(/ returnvalue
) (vl-cmdf "_layer" "m" "SF_Point" "c" "1" "" "") )
(vl-cmdf "_layer" "m" "SF_Line" "c" "155" "" "") )
(vl-cmdf "_layer" "m" "SF_Text" "c" "2" "" "") )
;; textsize
)
" >>"
)
)
)
)
)
;; ESC was pressed.
)
(setq *SF:Textsize
* returnvalue
) )
(prompt "\nUse 'DDPMODE' command to set POINT mode and size") )
;; --------------
(defun AT:GetSel
(meth msg fnc
/ ent
) ;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
("\nSelect object: ")
)
)
)
(princ "\nInvalid object!") )
)
)
)
)
ent
)
;; --------------
(defun AT:MText
(Pt Str Wd Lay Jus
/ Wd s o
) ;; Add MText to drawing
;; Pt - MText insertion point
;; Str - String to place in created MText object
;; Wd - Width of MText object (if nil, will be 0 width)
;; Lay - Layer to place Mtext object on (nil for current)
;; Jus - Justification # for Mtext object
;; 1 or nil= TopLeft
;; 2= TopCenter
;; 3= TopRight
;; 4= MiddleLeft
;; 5= MiddleCenter
;; 6= MiddleRight
;; 7= BottomLeft
;; 8= BottomCenter
;; 9= BottomRight
;; Alan J. Thompson, 05.23.09 / 04.09.10
)
)
)
)
)
)
)
)
)
:vlax-false
)
)
)
o
)
;; --------------
)
)
;; --------------
(defun AT:AngleAtPoint
(e p
) ;; Return angle along curve, at specified point (on curve)
;; e - valid curve (ENAME or VLA-OBJECT)
;; p - point on curve
;; Alan J. Thompson, 11.04.10
)
)
;;; (defun _getstring (m / s)
;;; (cond ((not (setq s (vl-string->list (getstring m)))) nil)
;;; ((if (and (vl-remove 43 s) (vl-position 43 s))
;;; (AT:ToStation (vl-list->string s))
;;; (progn (princ "\nInvalid station!") (_getstring m))
;;; )
;;; )
;;; )
;;; )
;; --------------
((AT:ToStation s))
((princ "\nInvalid station!") (_getstring m
)) )
)
)
)
;; --------------
(defun AT:ToStation
(val
/ foo
) ;; Convert number, number string, station string to valid station string
;; val - value to convert
;; Alan J. Thompson, 11.01.10
)
)
nil
)
(foo
(vl-list->string
;; rev kdub: (if (eq 2 (- (vl-position 46 l) (setq i (1+ i))))
;; rev kdub: to display "01+000.00"
)
)
)
l
)
)
)
)
-1
)
)
)
;; rev kdub: ((vl-some '(lambda (c) (wcmatch s c)) '("~*##+##`.##*" "*+*+*" "*`.*`.*")) nil)
;; rev kdub: to display "01+000.00"
'("~*##+###`.##*" "*+*+*" "*`.*`.*")
)
nil
)
(s)
)
)
)
;; --------------
;; -- MAIN ------
;; rev kdub: _Setup added kdub@theSwamp
(_setup)
"\nSelect alignment: "
)
)
)
)
)
)
)
'StartingStation
)
)
)
((_getstring
(strcat "\nSpecify starting station <" ((setq *SF:Sta
* (AT:ToStation
1000.
))) )
">: "
)
)
)
(*SF:Sta*)
)
)
)
(_getstring
(strcat "\nStarting station: " *SF:Sta*
" ~ Ending Station: "
(At:ToStation
(+ (AT:Sta2Num *SF:Sta*)
)
)
"\nSpecify station to find: "
)
)
)
(- (AT:Sta2Num s) (AT:Sta2Num *SF:Sta*))
)
)
(strcat "\nSpecify offset for station \"" s
"\" (+ = Right, - = Left) <0.00>: "
)
)
)
(0.)
)
)
;; rev kdub:
)
)
)
;;; (entmake (list '(0 . "CIRCLE")
;;; (cons 10 p)
;;; (cons 40
;;; (cond ((zerop o) (fix (* 0.1 (getvar 'viewsize))))
;;; ((* 0.1 o))
;;; )
;;; )
;;; )
;;; )
;; rev kdub:
)
)
)
(AT:MText p
(strcat "STATION: " s
) 0.
"SF_Text" 4) )
((AT:MText
0.
"SF_Text"
5 ; middle-center
)
)
)
ang
)
;; ^^ ;; rev kdub: ---
(- (AT:AngleAtPoint e p) (/ pi 2.))
(+ (AT:AngleAtPoint e p) (* pi 1.5))
)
)
)
(alert (strcat "Station \"" s
"\" outside of alignment limits!")) )
)
)
)
