[编程交流] 链测长度表示法

;; ********** Miscellaneous Entries **********
; Alternative GROUND LEVEL, PIPE INVERT LEVEL, PIPE DEPTH AND CHAINAGE entry
(defun C:GROUND ( )
           (points)
           (lines)
           (texts)
)
; Entry points for Ground Level and Pipe Invert Level
(defun points ( )
           (setq glp (getpoint "\nEnter Ground Level (endpoint):  ")  ; Ground Level Entry
                    plp (getpoint "\nEnter Pipe Invert Level (intersection):  "))  ;Pipe Invert Level Entry
)
;Vertical lines sub-routine
(defun lines ( )
; ground level
           (setq lingl1 (list (nth 0 glp) (nth 1 ptth1))
                   lingl2 (list (nth 0 glp) (nth 1 ptgl1)))
           (command "line" lingl1 lingl2 "")
; pipe invert and depth of pipe
          (setq linpinv (list (nth 0 plp) (nth 1 ptgl1))
                   lindep (list (nth 0 plp) (nth 1 ptdep1)))
           (command "line" linpinv lindep "")
; chainage
          (setq linch1 (list (nth 0 glp) (nth 1 ptdep1))
                   linch2 (list (nth 0 glp) (nth 1 ptch1)))
           (command "line" linch1 linch2 "")
)
(defun texts  ( / _AddSta)
(defun _AddSta (num /)
 (if (>= num 1000.0)
   (strcat ((lambda (s)
              (substr s 1 (- (strlen s) 3))
             )
             (vl-string-left-trim "+0" (_AddSta (fix (/ num 1000.0))))
           )
           (vl-string-left-trim "0" (_AddSta (rem num 1000.0)))
   )
   (strcat ((lambda (s)
              (while (< (strlen s) 5) (setq s (strcat s "0")))
              s
            )
             (vl-string-translate ",." "++" (rtos (/ num 1000.0) 2 3))
           )
           ((lambda (s)
              (if (eq s "")
                (setq s ".00")
                (while (< (strlen s) 3) (setq s (strcat s "0")))
              )
              s
            )
             (vl-string-left-trim "0" (rtos (rem num 1.0) 2 2))
           )
   )
 )
)
 ;; Level/Chainage texts
 (setq glvl   (rtos (/ (cadr glp) 10) 2 2) ; Ground level
       plvl   (rtos (/ (cadr plp) 10) 2 2) ; Pipe invert level
       deplvl (rtos (/ (- (cadr glp) (cadr plp)) 10) 2 2) ; Depth of pipe invert
       ch     (_AddSta (car glp)) ; Chainage
 )
 ;; Text co-ordinates
 (setq psnglvl (list (- (car glp) 0.75) (+ (cadr ptgl1) 0.5)) ; co-ordinate position for ground level text
       psnplvl (list (- (car plp) 0.75) (+ (cadr ptinv1) 0.5)) ; co-ordinate position for pipe invert level text
       psndep  (list (- (car plp) 0.75) (+ (cadr ptdep1) 0.5)) ; co-ordinate position for depth of pipe text
       psnch   (list (- (car glp) 0.75) (+ (cadr ptch1) 0.5)) ; co-ordinate position for chainage text
 )
 ;; Labelling levels and chainages
 (command "text" psnglvl 5.0 90.0 glvl)
 (command "text" psnplvl 5.0 90.0 plvl)
 (command "text" psndep 5.0 90.0 deplvl)
 (command "text" psnch 5.0 90.0 ch)
)
; ***** HGL *****
(defun C:HGL ( )
          (dim)
          (hglslope)
)
            
(defun hglslope ( )
(setq  ar1 (getpoint "\nEnter LHS point  :")   ;User input for arrow line, ar1
        ar2 (getpoint "\nEnter RHS point  :"))   ;User input for arrow line, ar2
(setq xdiff (* (- (car ar2) (car ar1) ) 1)
        ydiff (/ (- (cadr ar2) (cadr ar1) ) 10) )
(setq grad1 (/ ydiff xdiff))
(setq hglvltxt (rtos grad1 2 3) )
 (setq ar11 (list (car ar1) (cadr pthyd1))
          ar21 (list (car ar2) (cadr pthyd1)))
(setq ar1x (/ (+ (car ar1) (car ar2) ) 2)
        ar1y (/(+(cadr ptgeo1) (cadr pthyd1) ) 2))
(setq ar31 (list ar1x ar1y))
(command "dim" "hor" ar11 ar21 ar31 hglvltxt "" "exit")
(setq lin2 (list (nth 0 ar1) (nth 1 ptgeo1))
               lin3 (list (nth 0 ar1) ( nth 1 pthyd1)) )
       (command  "line" lin2 lin3 "" )
(setq gl1 ( rtos (/ (cadr ar1) 10) 2 2) ) ; Hydraulic Gradient Level 
         (setq psnhgl (list (- (car ar1) 0.75) (+ (cadr pthyd1) 0.5) ) ) ; coordinate of the HGL text
          (command "text" psnhgl 2.2 90.0 gl1)
(setq lin2 (list (nth 0 ar2) (nth 1 ptgeo1))
               lin3 (list (nth 0 ar2) ( nth 1 pthyd1)) )
       (command  "line" lin2 lin3 "" )
(setq gl1 ( rtos (/ (cadr ar2) 10) 2 2) ) ; Hydraulic Gradient Level 
         (setq psnhgl (list (- (car ar2) 0.75) (+ (cadr pthyd1) 0.5) ) ) ; coordinate of the HGL text
          (command "text" psnhgl 2.2 90.0 gl1)
)