[编程交流] 高到低波浪路径

; Function Plot
; by Mark Mercier
(defun c:fnplot(/ list1)
 ; Plot function
 (setq echo (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 
 (setq lowerBnd 0.0000000
   upperBnd 10.0000000
   precisionX 2000
   precisionY precisionX
   results "hi"
   )
 (setq incrementX (/ (- upperBnd lowerBnd) precisionX))
 (setq incrementY (/ (- upperBnd lowerBnd) precisionY))
 (setq dum1 lowerBnd)
 (repeat precisionX ; Begin repeat loop
   (setq x dum1)
   (setq dum2 lowerBnd)
   (repeat precisionY ; Begin nested repeat loop
     (setq y dum2)
     (sinusoid x)
     ;(logarithm x)
     ;(dampedvibration x)
     ;(polynom x)
     
     (wheel)
     (setq dum2 (+ dum2 incrementY))
     ); /nested repeat
   (setq dum1 (+ dum1 incrementX))
   ); /repeat
 (if list1
   (scribblescribble)
   )
 
 (setvar "cmdecho" echo)
 (princ)
 ); /program
; -- Cheap error function
(defun goodtimes()
 (princ "Strong Bad, help! I swallowed a bug! The good times are over!")(princ)
 )
; -- Wheel function for spinnyness --
(defun wheel ()
(if (not wh)(setq wh "-"))
(cond
((= wh "|") (setq wh "/"))
((= wh "/") (setq wh "-"))
((= wh "-") (setq wh "\"))
((= wh "\") (setq wh "|"))
)
(prompt (strcat "\10" wh))
(princ)
)
; Line Sinusoid
(defun sinusoid(x /)
 (setq precisionY 1)
 
 (setq y_sinusoid (* 2 (sin x)))
 (setq list1 (append list1 (list (list x y_sinusoid 0))))
 )
; Line Polynomial
(defun polynom(x /)
 (setq precisionY 1)
 
 (setq consList (list 7 5 4 6 4 2 8 6 5 5 2))
 
 (setq y_polynom 0)
 (setq dumVar 0)
 (repeat (- (length consList) 1)
   (setq y_polynom (+ y_polynom (* (nth dumVar consList) (expt x (- (- (length consList) 1) dumVar)))))
   (setq dumVar (+ 1 dumVar))
   )
 (setq y_polynom (+ y_polynom (nth (- (length consList) 1) consList)))
 
 (setq list1 (append list1 (list (list x y_polynom 0))))
 )
; Line Damped Vibration
(defun dampedvibration(x /)
 (setq precisionY 1)
 (setq time x)
 ; Set up initial conditions for forced, underdamped response (0 < zeta < 1)
 (setq mass 1)                                ; m
 (setq damping_coeff 0)                        ; c        If 0, undamped
 (setq spring_const 2)                            ; k
 
 (setq initDis 1)                            ; x_o
 (setq initVel 0)                            ; v_o
 (setq initFor 10)                            ; F_o        If 0, free response
 
 (setq dampRat (/ damping_coeff (* 2 (sqrt (* spring_const mass)))))    ; zeta
 ; * Zeta must be greater than zero but less than one to proceed * ;
 (if (and (>= dampRat 0) (< dampRat 1))
   (progn
     ; Determine minor variables from initial conditions
     (setq modinitFor (/ initFor mass))                    ; f_o
 
     (setq drivFreq 1.1)                                ; omega
 
     (setq natFreq (sqrt (/ spring_const mass)))                ; omega_n
     (setq dampednatFreq (sqrt (- 1 (* natFreq dampRat dampRat))))        ; omega_d
     ; Determine major variables from minor variables
     (setq omn2_om (- (expt natFreq 2) (expt drivFreq 2)))
     (setq 2zomnom (* 2 dampRat natFreq drivFreq))
     (setq coefX (/ modinitFor (sqrt (+ (expt omn2_om 2) (expt 2zomnom 2)))))
     (setq theta (atan (/ 2zomnom omn2_om)))
     (setq XcosTheta (* coefX (cos theta)))
     (setq phiNum (* dampednatFreq (- initDis XcosTheta)))
     (setq phiDen (+ initVel (* natFreq dampRat (- initDis XcosTheta)) (* -1 drivFreq coefX (sin theta))))
     (if (and (= damping_coeff 0) (= initVel 0))    ; Test if undamped
       (setq phi 0)                    ; If undamped, set phi to zero
   (setq phi (atan (/ phiNum phiDen)))        ; Otherwise
      )
     (setq coefA (/ (- initDis XcosTheta) (sin phi)))
     (setq expo (expt 2.71828183 (* -1 dampRat dampednatFreq time)))
     ; Use major and minor variables to assemble general response function x(t)
     (setq dampingTerm (* coefA expo (sin (+ (* dampednatFreq time) phi))))
     (setq forcingTerm (* coefX (cos (- (* drivFreq time) theta))))
     ; Final response
     (setq y_dampedvibe (+ dampingTerm forcingTerm))
 
     (setq list1 (append list1 (list (list x y_dampedvibe 0))))
     )
   (progn
     )
   )
 )