[编程交流] 线路、桥的不同层

(defun c:MHSW (/ _L _P _T p p1 p2 a ang l i)
;;; =============------------ Tharwat 27. Jan. 2013 -----------=========;;;
;;; Prompt to user to specify Distance between Manholes         ;;;
;;; then height of the text and finally to specify start and end points    ;;;
 (defun *error* (x) (princ "\n *Cancel*"))
 (cond ((not (tblsearch "LAYER" "pipe"))
        (progn (alert "Layer < pipe > is not found in drawing !!") (exit))
       )
       ((not (tblsearch "LAYER" "manhole"))
        (progn (alert "Layer < manhole > is not found in drawing !!") (exit))
       )
       ((not (tblsearch "LAYER" "textlength"))
        (progn (alert "Layer < textlength > is not found in drawing !!") (exit))
       )
 )
 (defun _L (j k) (entmakex (list '(0 . "LINE") '(8 . "pipe") (cons 10 j) (cons 11 k))))
 (defun _P (p) (entmakex (list '(0 . "POINT") '(8 . "manhole") (cons 10 p))))
 (defun _T (p h s a)
   (entmakex (list '(0 . "TEXT")
                   (cons 10 (trans p 1 0))
                   (cons 11 (trans p 1 0))
                   '(8 . "textlength")
                   (cons 40 h)
                   (cons 1 s)
                   (cons 50 a)
                   '(72 . 1)
                   '(73 . 1)
             )
   )
 )
 (if (and (if (progn (initget 6)
                     (setq *d* (cond ((getdist (strcat "\n Specify distance between Manholes "
                                                       (if *d*
                                                         (strcat "< " (rtos *d* 2 2) " > :")
                                                         " :"
                                                       )
                                               )
                                      )
                                     )
                                     (t *d*)
                               )
                     )
              )
            (setq *d* *d*)
            nil
          )
          (if (progn (initget 6)
                     (setq *h* (cond ((getdist (strcat "\n Specify Text Height "
                                                       (if *h*
                                                         (strcat "< " (rtos *h* 2 2) " > :")
                                                         " :"
                                                       )
                                               )
                                      )
                                     )
                                     (t *h*)
                               )
                     )
              )
            (setq *h* *h*)
            nil
          )
          (setq p1 (getpoint "\n specify start point :"))
          (setq p2 (getpoint "\n Specify end point :" p1))
     )
   (progn (setvar 'pdmode 65)
          (setq a   (angle p1 p2)
                ang a
          )
          (if (and (< (* pi 0.5) ang) (<= ang (* pi 1.5)))
            (setq ang (+ pi ang))
            ang
          )
          (mapcar '_P (list p1 p2))
          (setq l (distance p1 p2))
          (repeat (fix (/ l *d*))
            (_L p1 (setq p (polar p1 a *d*)))
            (_P p)
            (_T (mapcar '(lambda (j k) (/ (+ j k) 2.)) p1 p) *h* (strcat "L= " (rtos *d* 2 1)) ang)
            (setq p1 p)
          )
          (if (> (setq i (rem l *d*)) 0.)
            (progn (_L p1 p2)
                   (_T (mapcar '(lambda (j k) (/ (+ j k) 2.)) p1 p2)
                       *h*
                       (strcat "L= "
                               (if (< i 0.)
                                 (rtos i 2 2)
                                 (rtos i 2 1)
                               )
                       )
                       ang
                   )
            )
          )
   )
   (princ)
 )
 (princ "\nWritten by Tharwat Al Shoufi")
 (princ)
)