[LISP程序]：设计中问题求教~

shiquan

你好：

      我编好一个DCL对话框和LISP程序的代码，但是我不知道怎么衔接这两个方面，使我在DCL对话框中输入参数，就可以调用运行LISP程序！谢谢！

DCL代码：
sunshade: dialog {
      label = "绘制日照棒影图";
      :row{
      :boxed_column{
          label = "数据输入窗口";
          :edit_box{label = "太阳 赤纬角 &δ (度):";  
                edit_width = 10;
                key = "δ";
                value = "";
                }
          :edit_box{label = "地 理 纬 度 &Φ (度):";
                width = 10;
                mnemonic= "Φ";
                key = "Φ";
                value = "";
                }                    
           :edit_box{label = "棒       高 &Η (mm):";
                width = 10;
                mnemonic= "Η";
                key = "Η";
                value = "";
                }
             }
          }
       ok_cancel;
     }  

LISP代码：

;;;convert angle in degrees to radians
(defun dtr (a)
  (* pi (/ a 180.0))
)
(defun c:SUNSHADE (/   pt  hg  φ  δ  Ω  A1  A10 A11 A12 A13 A14 A15
           A16 A17 A2  A3  A4  A5  A6  A7  A8  A9  AS  C   H
           TT  X   Y   Z
          )

  (setvar "cmdecho" 0)
  (setq pt (getpoint "\n enter a point:"))
  (setq hg (getreal "\n enter a high:"))
  (setq δ (getangle "\n 输入地区太阳赤纬角 δ=:"))
  (setq φ (getangle "\n 输入地区地理纬度 φ=:"))

;;;(command "layer" "m" "2" "on" "2" "1" "continuous" "2" "")
;;;(command "color" 2)

  (setq tt 4)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq H (* hg (/ y x)) ;y/x====x/y
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a1 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a1 "")
  (command "text" a1 40 "" "8时")

  (setq tt 3.5)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a2 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a2 "")

  (setq tt 3)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a3 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a3 "")
  (command "text" a3 40 "" "9时")

  (setq tt 2.5)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a4 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a4 "")

  (setq tt 2)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a5 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a5 "")
  (command "text" a5 40 "" "10时")

  (setq tt 1.5)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a6 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a6 "")

  (setq tt 1)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a7 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a7 "")
  (command "text" a7 40 "" "11时")

  (setq tt 0.5)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a8 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a8 "")

  (setq tt 0)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a9 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a9 "")
  (command "text" a9 40 "" "12时")

  (setq tt -0.5)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a10 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a10 "")

  (setq tt -1)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a11 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a11 "")
  (command "text" a11 40 "" "13时")

  (setq tt -1.5)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a12 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a12 "")

  (setq tt -2)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a13 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a13 "")
  (command "text" a13 40 "" "14时")

  (setq tt -2.5)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a14 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a14 "")

  (setq tt -3)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a15 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a15 "")
  (command "text" a15 40 "" "15时")

  (setq tt -3.5)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a16 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a16 "")

  (setq tt -4)
  (setq Ω (* 15 tt))
  (setq    x (+ (* (sin φ) (sin δ))
         (* (cos φ) (cos δ) (cos (dtr Ω)))
      )
  )
  (setq y (sqrt (- 1 (* x x))))
  (setq    H (* hg (/ y x))
  )
  (setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
  (setq    as (atan (/ z (sqrt (- 1 (* z z)))))
  )
  (setq a17 (polar pt (- as (/ pi 2)) H))
  (command "line" pt a17 "")
  (command "text" "r" a17 40 "" "16时")

  (command "line" a1 a2    a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16
       a17 "")
  (command "zoom" "e")
)

kevinchan

[PHP]
;;;convert angle in degrees to radians
(defun dtr (a)
(* pi (/ a 180.0))
)
(defun c:SUNSHADE (/ pt hg φ δ Ω A1 A10 A11 A12 A13 A14 A15
A16 A17 A2 A3 A4 A5 A6 A7 A8 A9 AS C H
TT X Y Z
                   )
(setvar "cmdecho" 0)
(dcl_sunshade)
(prin1)
)

(defun dcl_sunshade()
  (setq dcl_id (load_dialog "sunshade")) ;载入DCL文件
  (new_dialog "sunshade" dcl_id)       
  (set_tile "hg1" "150")                ;设定值
  (set_tile "δ1" "80")       
  (set_tile "φ1" "50")       
  (action_tile "draw_ok" "(get_sun)(done_dialog 1)")
  (start_dialog)
  (sunshade1)
)

(defun get_sun()
  (setq hg (atof (get_tile "hg1")))
  (setq δ (atof (get_tile "δ1")))
  (setq φ (atof (get_tile "φ1")))
)

(defun sunshade1()       
(setq pt (getpoint "\n enter a point:"))
;;;(setq hg (getreal "\n enter a high:"))
;;;(setq δ (getangle "\n 输入地区太阳赤纬角 δ=:"))
;;;(setq φ (getangle "\n 输入地区地理纬度 φ=:"))
;;;(command "layer" "m" "2" "on" "2" "1" "continuous" "2" "")
;;;(command "color" 2)
(setq tt 4)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x)) ;y/x====x/y
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a1 (polar pt (- as (/ pi 2)) H))
(command "line" pt a1 "")
(command "text" a1 40 "" "8时")

(setq tt 3.5)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a2 (polar pt (- as (/ pi 2)) H))
(command "line" pt a2 "")

(setq tt 3)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a3 (polar pt (- as (/ pi 2)) H))
(command "line" pt a3 "")
(command "text" a3 40 "" "9时")

(setq tt 2.5)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a4 (polar pt (- as (/ pi 2)) H))
(command "line" pt a4 "")

(setq tt 2)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a5 (polar pt (- as (/ pi 2)) H))
(command "line" pt a5 "")
(command "text" a5 40 "" "10时")

(setq tt 1.5)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a6 (polar pt (- as (/ pi 2)) H))
(command "line" pt a6 "")

(setq tt 1)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a7 (polar pt (- as (/ pi 2)) H))
(command "line" pt a7 "")
(command "text" a7 40 "" "11时")

(setq tt 0.5)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a8 (polar pt (- as (/ pi 2)) H))
(command "line" pt a8 "")

(setq tt 0)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a9 (polar pt (- as (/ pi 2)) H))
(command "line" pt a9 "")
(command "text" a9 40 "" "12时")

(setq tt -0.5)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a10 (polar pt (- as (/ pi 2)) H))
(command "line" pt a10 "")

(setq tt -1)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a11 (polar pt (- as (/ pi 2)) H))
(command "line" pt a11 "")
(command "text" a11 40 "" "13时")

(setq tt -1.5)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a12 (polar pt (- as (/ pi 2)) H))
(command "line" pt a12 "")

(setq tt -2)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a13 (polar pt (- as (/ pi 2)) H))
(command "line" pt a13 "")
(command "text" a13 40 "" "14时")

(setq tt -2.5)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a14 (polar pt (- as (/ pi 2)) H))
(command "line" pt a14 "")

(setq tt -3)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a15 (polar pt (- as (/ pi 2)) H))
(command "line" pt a15 "")
(command "text" a15 40 "" "15时")

(setq tt -3.5)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a16 (polar pt (- as (/ pi 2)) H))
(command "line" pt a16 "")

(setq tt -4)
(setq Ω (* 15 tt))
(setq x (+ (* (sin φ) (sin δ))
(* (cos φ) (cos δ) (cos (dtr Ω)))
)
)
(setq y (sqrt (- 1 (* x x))))
(setq H (* hg (/ y x))
)
(setq z (/ (* (sin (dtr Ω)) (cos δ)) y))
(setq as (atan (/ z (sqrt (- 1 (* z z)))))
)
(setq a17 (polar pt (- as (/ pi 2)) H))
(command "line" pt a17 "")
(command "text" "r" a17 40 "" "16时")

(command "line" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16
a17 "")
(command "zoom" "e")
)
[/PHP]

[PHP]
sunshade: dialog {
label = "绘制日照棒影图";
:row{
:boxed_column{
label = "数据输入窗口";
:edit_box{label = "太阳 赤纬角 &δ (度):";
edit_width = 10;
key = "δ1";
value = "";
}
:edit_box{label = "地 理 纬 度 &Φ (度):";
width = 10;
mnemonic= "φ";
key = "φ1";
value = "";
}
:edit_box{label = "棒 高 &Η (mm):";
width = 10;
mnemonic= "Η";
key = "hg1";
value = "";
}
}
}
:row{
fixed_width=true;
alignment=centered;
:button{label="确定";key="draw_ok";width=4;}   
cancel_button;
}
}
[/PHP]

它山之石

徐州的兄弟吧，怎么换马甲了？