autolisp求助（急 )

terrykim · 发表于 2002-6-9 11:17:00

我想把下面的程序加上dcl对话框输出。但不知如何作，求高手帮忙(defun dtr (cta)
  (* pi (/ cta 180.0))
  ) ;_ 结束defun
(defun do_dl1 ()
  (setq cta (dtr 38.00))
  (command "layer" "s" "基本图素" "on" "基本图素" "")
                                    ;(command "layer" "m" "0" "ON" "0" "L" "continuous" "0" "")
  (setq ao (list "O" 2.5 9.5 12 8 5.5 10.2))
  (setq aa (list "A" 3.5 12 15 10 6 13.4))
  (setq ab (list "B" 5 15 20 12.5 7.5 17.4))
  (setq ac (list "C" 6 20 25.5 17 10 22.6))
  (setq ad (list "D" 8.5 28 37 24 12 32.9))
  (setq ae (list "E" 10 3.3 44.5 29 15 38.9))
  (setq af (list "F" 12.5 42 58 38 18 50.6))
  (setq a (list ao aa ab ac ad ae af))       ;输入带轮型号
  (setq 类型 (getstring "类型=:"))
  (setq 类型 (strcase 类型))
  (setq lis (assoc 类型 a))
  (setq he (nth 1 lis))
  (setq H (nth 2 lis))
  (setq e (nth 3 lis))
  (setq f (nth 4 lis))
  (setq h1 (nth 5 lis))
  (setq b0 (nth 6 lis))
  (cond       ((= 类型 "O")
      (setq d (getint "choose d=100 125 160 200)"))
      )                               ; choose d
      ((= 类型 "A")
      (setq d (getint
               "choose d=125 140 160 180 200 250 315 400 500 630)"
               ) ;_ 结束getint
            ) ;_ 结束setq
      )
      ((= 类型 "B")
      (setq d (getint "choose d=200 250 315 400 500 63 800 1000)"))
      )
      ((= 类型 "C")
      (setq d (getint "choose d=315 400 500 630 800 1000 1250 1600)"))
      )
      ((= 类型 "D")
      (setq
         d (getint "choose d=500 630 800 1000 1120 1400 1600 2000)")
         ) ;_ 结束setq
      )
      ((= 类型 "E")
      (setq
         d (getint "choose d=630 710 800 1000 1250 1600 2000 2500)")
         ) ;_ 结束setq
      )
      ((= 类型 "F")
      (setq d (getint "choose d=800 1000 1120 1400 1600 200 2500)"))
      )
      ) ;_ 结束con
  (setq P0 (getpoint "left corner:"))
  (setq k (/ H (cos (/ cta 2.0))))
  (setq a2 (- b0 (* 2.0 k (sin (/ cta 2.0)))))
  (setq a1 (- f (/ a2 2) (* k (sin (/ cta 2)))))
  (setq a3 (- f (/ a2 2) (* k (sin (/ cta 2)))))
  (setq de (+ d (* 2.0 he)))
  (setq dhmx (- de (* 2.0 (+ H h1))))
  (setq dh (getreal (strcat "choose dh:" (rtos dhmx 2 2) ">")))
  (setq P1 (polar P0 (* 0.5 pi) (/ (- de dh) 2)))
  (setq p2 (polar p1 0 a1))
  (setq p3 (polar p2 (- (/ cta 2) (* 0.5 pi)) k))
  (setq p4 (polar p3 0 (/ a2 2)))
  (setq pt (polar p3 0 (/ a2 2)))
  (setq n (getint "输入槽数=:"))
  (command "pline" p0 p1 p2 p3 p4 pt)
  (repeat (- n 1)
(command
   (setq Pt (polar Pt (- (* 0.5 pi) (/ cta 2)) k))
   (setq pt (polar pt 0 a3))
   (setq Pt (polar Pt (- (/ cta 2) (* 0.5 pi)) k))
   (setq Pt (polar Pt 0 a2))
   ) ;_ 结束command
) ;_ 结束repeat
  (command
(setq p5 (polar pt (- (* 0.5 pi) (/ cta 2)) k))
(setq p6 (polar p5 0 a1))
(setq p66 (polar p6 (* 1.5 pi) H))
(setq p7 (polar p66 (* 1.5 pi) (- (/ (- de dh) 2) H)))
"c"
) ;_ 结束command
  (setq Pl (polar P7 (* 1.5 pi) (/ dh 2)))
  (command "line" P7 pl "")             ;画两条段
  (setq Pc (polar P0 (* 1.5 pi) (/ dh 2)))
  (command "line" P0 Pc "")
                                    ;(command "layer" "m" "2" "2" "on" "2" "L" "center" "2" "")
                                    ;(command "layer" "s" "基本图素" "on" "基本图素" "")
  (command "layer" "s" "中心线" "on" "中心线" "")
  (command "line" Pc pl "")             ;中心xian
                                    ; (command "linetype" "s" "continuous" "")
  (setq ss (ssget "X" (list (cons 8 "基本图素"))))
  (command "mirror" SS "" pc pl "")
                                    ;(command "layer" "s" "0" "ON" "0" "")
  (command "layer" "s" "剖面线" "on" "剖面线" "")
  (setq P11 (polar Pc (* 1.5 pi) (/ de 2)))
  (setq p21 (polar p2 -90 3))
  (setq p12 (polar p11 45 3))
                                    ;(command "circle" p12 10)                                     ;(setq
                                    ;(command "mirror" p21 "" pc pl "")
                                    ;(command "circle" p21 10)
  (command "bhatch" "p" "line" "1" "45" p21 p12 "") ;剖面线
  ) ;_ 结束defun

jingsabing · 发表于 2002-6-10 09:05:00

(setq B_id (load_dialog "B_DRAWING"));装入B_DRAWING.DCL
  (if (not (new_dialog "B_DRAWING" B_id))
   (exit)
  );end-if
...
....
...
  (unload_dialog B_id)

autolisp求助（急 )

发表回复

精选推荐

浏览过的版块