cul.lsp

c语言和c++的编程思想和c语言编程中常用的一些算法的代码

 
(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