(DEFUN UCSPP (PO_BAS) (COMMAND "UCS" "O" PO_BAS))
(defun c:zy(/ N_POI Q_POI E_POI K_POI WJ1 WJ2 WJ3)
 (setvar "cmdecho" 0)
 (command "limits" "" "1200,900" "zoom" "a")
 (setvar "mirrtext" 0)
;; (SETQ PO_BAS (GETPOINT "\n繪圖基點:"))
  (setq po_bas '(100 400))
 (setq 
     wjm (getstring "\n輸入文件:")
     th  (getstring "\n輸入圖號:")
       N_POI (POLAR PO_BAS 0.0 200)
       Q_POI (POLAR PO_BAS 0.0 400)
     ;  E_POI (POLAR PO_BAS 0.0 600)
       K_POI (POLAR PO_BAS 0.0 600)
 )
 (CULSTAR WJM)
 (cul wjm)
 (command "color" "7")
 (setvar "cmdecho" 1)
);DEFUN


(DEFUN TEXTL3 (P ANG T) (COMMAND "TEXT" "J" "ML" P '3.0 ANG T))
(DEFUN TEXTR3 (P ANG T) (COMMAND "TEXT" "J" "MR" P '3.0 ANG T))
(DEFUN TEXTM5 (P T) (COMMAND "TEXT" "J" "M" P '5.0 0.0 T))
(DEFUN FSCA(A) (* A 10.0)) 
(DEFUN SCA(A MAXABS) (* A (/ 10.0 MAXABS)))
(DEFUN MAXMIN (LST NUM / N)
      (SETQ N '0
            MAX (NTH N LST)
            MIN (NTH N LST)
      )
      (WHILE (<= N NUM)
          (SETQ MA (NTH N LST)
                MI (NTH N LST)
          )
          (IF (<= MAX MA) (SETQ MAX MA))
          (IF (>= MIN MI) (SETQ MIN MI))
          (SETQ N (+ 1 N))
     )
     (IF (<= (ABS MAX) (ABS MIN)) 
         (SETQ MAXABS (ABS MIN))
         (SETQ MAXABS (ABS MAX))
     )
);DEFUN



(DEFUN CUL(XXX / F CO ANG M N Q E K) 
 (setq f (open XXX "r")
       first '0 )
       
 (setq con (read-line f))
 (while con
 (setq
       JJJ '1
       co (read con)
       CEN (LIST (FSCA (CAR (CAR CO))) (FSCA (CADR (CAR CO))))
       SPO (LIST (FSCA (CAR (CADR CO))) (FSCA (CADR (CADR CO))))
       EPO (LIST (FSCA (CAR (CADDR CO))) (FSCA (CADR (CADDR CO))))
       NUM (CADDDR CO)
       RADU (DISTANCE CEN SPO)
 )
 (SETQ 
      con (READ-LINE F)
      CO (READ con)
      ANG (CAR CO)
      M (CADR CO)
      N (* -1.0 (CADDR CO))
      Q (CADDDR CO)
      E (NTH 4 CO)
      K (NTH 5 CO)
    LANG (LIST ANG)
 )
 (IF (= FIRST 1)
    (SETQ LM (LIST ENDM)
          LN (LIST ENDN)
          LQ (LIST ENDQ)
          LE (LIST ENDE) 
          LK (LIST ENDK)
    )
    (SETQ LM (LIST M)
          LN (LIST N)
          LQ (LIST Q)
          LE (LIST E) 
          LK (LIST K)
    )
    
 )

 (WHILE (<= JJJ NUM)
  (SETQ CO (READ (READ-LINE F))
      ANG (CAR CO)
      M (CADR CO)
      N (* -1.0 (CADDR CO))
      Q (CADDDR CO)
      E (NTH 4 CO)
      K (NTH 5 CO)
     LANG (APPEND LANG (LIST ANG))
     LM (APPEND LM (LIST M))
     LN (APPEND LN (LIST N))
     LQ (APPEND LQ (LIST Q))
     LE (APPEND LE (LIST E))
     LK (APPEND LK (LIST K))
  )
   
   (IF (= JJJ NUM)
       (SETQ ENDM M 
             ENDN N 
             ENDQ Q 
             ENDE E 
             ENDK K 
       )
   )      
   
   (SETQ  JJJ (+ 1 JJJ)
   )
  
 );WHILE---1 
;;;;;;;;;;;;;;;;彎矩圖  
 (ucspp po_bas)
 (m123 lm MAXM)
 (command "mirror" "w" "-25,-55" "90,80" "" "0,0" "0,100" "")
 (command "ucs" "w")
 (textm5 (polar po_bas (* 1.5 pi) 60.0) "彎 矩 圖")
 (textm5 (polar po_bas (* 1.5 pi) 70.0) th)
;;;;;;;;;;;;;;;;軸力圖 
 (ucspp N_POI)
 (m123 LN MAXN)
 (command "mirror" "w" '(-25 -55) '(90 80) "" '(0 0) '(0 100) "")
 (command "ucs" "w")
 (textm5 (polar N_POI (* 1.5 pi) 60.0) "軸 力 圖")
 (textm5 (polar N_POI (* 1.5 pi) 70.0) th)
;;;;;;;;;;;;;;;;剪力圖 
 (ucspp Q_POI)
 (m123 LQ MAXQ)
 (command "mirror" "w" '(-25 -55) '(90 80) "" '(0 0) '(0 100) "")
 (command "ucs" "w")
 (textm5 (polar Q_POI (* 1.5 pi) 60.0) "剪 力 圖")
 (textm5 (polar Q_POI (* 1.5 pi) 70.0) th)
;;;;;;;;;;;;;;;;偏心矩圖 
; (ucspp E_POI)
; (m123 LE MAXE)
; (command "mirror" "w" '(-25 -55) '(90 80) "" '(0 0) '(0 100) "")
; (command "ucs" "w")
; (textm5 (polar E_POI (* 1.5 pi) 60.0) "偏 心 距 圖")
; (textm5 (polar E_POI (* 1.5 pi) 70.0) th)
;;;;;;;;;;;;;;;;安全系數圖 
 (ucspp K_POI)
 (m123 LK MAXK)
 (command "mirror" "w" '(-25 -55) '(90 80) "" '(0 0) '(0 100) "")
 (command "ucs" "w")
 (textm5 (polar K_POI (* 1.5 pi) 60.0) "安 全 系 數 圖")
 (textm5 (polar K_POI (* 1.5 pi) 70.0) th)
;;;;;;;;;;;;;;;;彎矩圖  
 
 (if (= first 0)
  (setq first '1)
 )
(setq con (read-line f))
);;;----2--while
(CLOSE F)
);;;DEFUN


(DEFUN M123(zy MAX / N NN AAA BBB) 
(COMMAND "ARC" "C" CEN EPO SPO)
;;;;畫彎矩圖 
 
;;;;;;;    (MAXMIN zy NUM)
 
 (SETQ N '0)
 (SETQ 
      AAA (NTH N LANG)
      BBB (+ RADU (SCA (NTH N zy) MAX))
      MPO (list (polar cen AAA BBB))
      N (+ 1 N)
 )
 (WHILE (<= N NUM)
    (SETQ 
          AAA (NTH N LANG)
          BBB (+ RADU (SCA (NTH N zy) MAX))
          MPO (APPEND MPO (list (polar cen AAA BBB)))
          N (+ 1 N)
    )
 )
 (SETVAR "CMDECHO" 0)
 (SETVAR "BLIPMODE" 0)
 (command "color" "1")
 (2spline mpo)
 (command "color" "4")
 (if (= first 0)
     (SETQ NN '0)
     (setq NN '1)
 )
 (WHILE (<= NN NUM)
        (TEXTL3 (NTH NN MPO) (ATOF (ANGTOS (NTH NN LANG) 0 6)) 
                (RTOS (NTH NN zy) 2 2)
        )  
        (SETQ NN (+ 1 NN))
 )
 (SETVAR "CMDECHO" 1)
 (SETVAR "BLIPMODE" 1)
 (command "color" "7")
 (PRINC)
);DEFUN------M123

;;;;;;;;;;;;;;;;;;;;;;;曲線擬合

(defun b2spline(x0 y0 x1 y1 x2 y2 n / a0 a1 a2 a3
                b0 b1 b2 b3 dt inn t tt ut x y )
 (setq a0 (/ (+ x0 x1) 2.0)
       b0 (/ (+ y0 y1) 2.0)
       a1 (- x1 x0)
       b1 (- y1 y0)
       a2 (/ (+ x0 (* -2.0 x1) x2) 2.0)
       b2 (/ (+ y0 (* -2.0 y1) y2) 2.0)
       dt (/ 1.0 n)
       inn '0
 );---------------setq
 (setq kw '0)
 (while (< inn n)
     (if (= kw 0)
       (setq t (* inn dt)
             tt (* t t)
             x (+ a0 (* a1 t) (* a2 tt))   
             y (+ b0 (* b1 t) (* b2 tt))
             p_list (list (list x y))

       )
       
       (setq t (* inn dt)
             tt (* t t)
             x (+ a0 (* a1 t) (* a2 tt))   
             y (+ b0 (* b1 t) (* b2 tt))
             tlist (list x y)
             p_list (cons tlist p_list)
       
       )
    );;;;if
    (setq kw (+ 1 kw))
   
   (setq inn (+ 1 inn))
 );while
          (SETQ   
             tlist (list (/ (+ X1 x2) 2.0) (/ (+ Y1 Y2) 2.0))
             p_list (cons tlist p_list)
         )
 (command "pline")
 (foreach py p_list (command py))
 (command "")
);defun-----b3pline

(defun 2spline(mpo / k1 lenlis p$1 p$2 p$3 x0 x1 x2 y0 y1 y2) 
 (setq k1 '0
       lenlis (length mpo)
 )
  (while (<= k1 (- lenlis 3)) 
    (setq p$1 (nth k1 mpo)
          p$2 (nth (+ 1 k1) mpo)
          p$3 (nth (+ 2 k1) mpo)
          x0 (car p$1)
          y0 (cadr p$1)
          x1 (car p$2)
          y1 (cadr p$2)
          x2 (car p$3)
          y2 (cadr p$3)
    )
   (if (= k1 0) 
    (b2spline x0 y0 x0 y0 x1 y1 8)
   )
    (b2spline x0 y0 x1 y1 x2 y2 8)
    (setq k1 (+ 1 k1))
  )
    (b2spline x1 y1 x2 y2 x2 y2 8)
);defun


(DEFUN CULstar(XXX / F CO ANG M N Q E K) 
 (setq f (open XXX "r")
       first '0 )
 (setq con (read-line f))
 (while con
 (setq
       JJJ '1
       co (read con)
       CEN (LIST (FSCA (CAR (CAR CO))) (FSCA (CADR (CAR CO))))
       SPO (LIST (FSCA (CAR (CADR CO))) (FSCA (CADR (CADR CO))))
       EPO (LIST (FSCA (CAR (CADDR CO))) (FSCA (CADR (CADDR CO))))
       NUM (CADDDR CO)
       RADU (DISTANCE CEN SPO)
 )
 ;(princ num)
 (SETQ 
      con (READ-LINE F)
      CO (READ con)
      ANG (CAR CO)
      M (CADR CO)
      N (* -1.0 (CADDR CO))
      Q (CADDDR CO)
      E (NTH 4 CO)
      K (NTH 5 CO)
    LANG (LIST ANG)
 )
 (IF (= FIRST 1)
    (SETQ LM (LIST ENDM)
          LN (LIST ENDN)
          LQ (LIST ENDQ)
          LE (LIST ENDE) 
          LK (LIST ENDK)
    )
    (SETQ LM (LIST M)
          LN (LIST N)
          LQ (LIST Q)
          LE (LIST E) 
          LK (LIST K)
    )
    
 )

 (WHILE (<= JJJ NUM)
  (SETQ CO (READ (READ-LINE F))
      ANG (CAR CO)
      M (CADR CO)
      N (* -1.0 (CADDR CO))
      Q (CADDDR CO)
      E (NTH 4 CO)
      K (NTH 5 CO)
     LANG (APPEND LANG (LIST ANG))
     LM (APPEND LM (LIST M))
     LN (APPEND LN (LIST N))
     LQ (APPEND LQ (LIST Q))
     LE (APPEND LE (LIST E))
     LK (APPEND LK (LIST K))
  )
   
   (IF (= JJJ NUM)
       (SETQ ENDM M 
             ENDN N 
             ENDQ Q 
             ENDE E 
             ENDK K 
       )
   )      
   
   (SETQ  JJJ (+ 1 JJJ)
   )
  
 );WHILE---1 
;;;;;;;;;;;;;;;;彎矩圖  
 (IF (= FIRST 0)
   (SETQ MAXM (MAXMIN LM (- (LENGTH LM) 1)))
   (if (< maxm (MAXMIN LM (- (LENGTH LM) 1))
       )
       (SETQ MAXM (MAXMIN LM (- (LENGTH LM) 1)))
   )
 )
;;;;;;;;;;;;;;;;軸力圖 
 (IF (= FIRST 0)
   (SETQ MAXN (MAXMIN LN (- (LENGTH LN) 1)))
   (if (< maxN (MAXMIN LN (- (LENGTH LN) 1))
       )
       (SETQ MAXN (MAXMIN LN (- (LENGTH LN) 1)))
   )
 )
;;;;;;;;;;;;;;;;剪力圖 
 (IF (= FIRST 0)
   (SETQ MAXQ (MAXMIN LQ (- (LENGTH LQ) 1)))
   (if (< MAXQ (MAXMIN LQ (- (LENGTH LQ) 1))
       )
       (SETQ MAXQ (MAXMIN LQ (- (LENGTH LQ) 1)))
   )
 )
;;;;;;;;;;;;;;;;偏心矩圖 
 (IF (= FIRST 0)
   (SETQ MAXE (MAXMIN LE (- (LENGTH LE) 1)))
   (if (< MAXE (MAXMIN LE (- (LENGTH LE) 1))
       )
       (SETQ MAXE (MAXMIN LE (- (LENGTH LE) 1)))
   )
 )
;;;;;;;;;;;;;;;;安全系數圖 
 (IF (= FIRST 0)
   (SETQ MAXK (MAXMIN LK (- (LENGTH LK) 1)))
   (if (< MAXK (MAXMIN LK (- (LENGTH LK) 1))
       )
       (SETQ MAXK (MAXMIN LK (- (LENGTH LK) 1)))
   )

 )
;;;;;;;;;;;;;;;;彎矩圖  
 
 (if (= first 0)
  (setq first '1)
 )
(setq con (read-line f))
);;;----2--while
(CLOSE F)
);;;DEFUN