土木在线论坛 \ 建筑设计 \ CAD下载及教程 \ 这个程序那里有问题?

这个程序那里有问题?

发布于:2007-04-22 21:14:22 来自:建筑设计/CAD下载及教程 [复制转发]
(defun c:gctk( / ty h w dw e pt0 pt1 pt2 pt3 my fa p1 p2 p3 p0 zg fa_d x0 y0 xn yn x y i j k x1 y1 wg p4 p5 p6 pt4 pt5 pt6 jdb jds xx chdw chrq chmj)
  (setq dcl_dtszh (load_dialog "jzth.dcl"))
  (if(not(new_dialog "tk" dcl_dtszh)) (exit))
  (setq w 840 h 594 dw 0 blc 0.5 e 1 ty 0) (hk)
  (if (/= tfm "") (set_tile "gcmc" tfm))
  (mode_tile "ds" 1) (mode_tile "fa" 1)
  (action_tile "bl_1" "(setq blc 0.5)")
  (action_tile "bl_2" "(setq blc 1.0)")
  (action_tile "bl_3" "(setq blc 2.0)")

  (action_tile "th_1" "(progn (setq h 594 w 840 dw 0) (hk))")
  (action_tile "th_2" "(progn (setq h 420 w 594 dw 0) (hk))")
  (action_tile "th_3" "(progn (setq h 297 w 420 dw 0) (hk))")

  (action_tile "jc" "(jch)")
  (action_tile "ds" "(progn (setq dw (atoi (get_tile \"ds\"))) (hk))")

  (action_tile "accept" "(tk_ok)")
  (action_tile "cancel" "(progn (done_dialog) (setq e 0))")
  (start_dialog)
  (unload_dialog dcl_dtszh)
  (setq w (+ w dw))
  (if (= e 1) (progn
    (command "layer" "m" "901" "c" 7 "" "")
    (setq my nil)
    (while (/= my "Y")
 (setq pt0 (getpoint "\n请指定图廓左下角"))
 (setq fa (getangle pt0 "\n请指定图框的方向"))
 (setq pt1 (polar pt0 fa (* w blc))
pt2 (polar pt1 (+ fa (/ pi 2)) (* h blc))
pt3 (polar pt0 (+ fa (/ pi 2)) (* h blc))
 )
 (command "pline" pt0 "w" 0 0 pt1 pt2 pt3 "c")
 (setq my (strcase (getstring "\n 是否满意? 回车重来, 打 Y 确定")))
 (if (/= my "Y") (command "erase" "l" ""))
    )
    (setq zg (* blc 4) fa_d (/ (* fa 180) pi))
    (setq pt (polar pt0 fa (* blc 10.0)))
    (setq p0 (polar pt (+ fa (/ pi 2)) (* blc 10))
       p1 (polar p0 fa (* (- w 20) blc))
       p2 (polar p1 (+ fa (/ pi 2)) (* (- h 20) blc))
       p3 (polar p0 (+ fa (/ pi 2)) (* (- h 20) blc))
    )
    (command "pline" p0 "w" 0 0 p1 p2 p3 "c")

    (if (= ty 1) (command "insert" "gctk" p1 blc blc fa_d chmj chrq
               (strcat "1:" (itoa (fix (+ (* blc 1000) 0.5)))) chdw tfm))
    (setq x0 (car p0) y0 (cadr p0) xn x0 yn y0)
   
    (setq x0 (min x0 (car p1)) y0 (min y0 (cadr p1)))
    (setq x0 (min x0 (car p2)) y0 (min y0 (cadr p2)))
    (setq x0 (min x0 (car p3)) y0 (min y0 (cadr p3)))
   
    (setq xn (max xn (car p1)) yn (max yn (cadr p1)))
    (setq xn (max xn (car p2)) yn (max yn (cadr p2)))
    (setq xn (max xn (car p3)) yn (max yn (cadr p3)))

    (setq p4 (polar p1 (+ pi fa) (* blc 100))
   p5 (polar p4 (+ fa (/ pi 2)) (* blc 45))
   p6 (polar p5 fa (* blc 100))
    d (list p0 p4 p5 p6 p2 p3)
    )
    (if (< x0 0)(setq fh 0)(setq fh 1))

    (setq wg (* blc 100)
   y (* (fix (/ y0 wg)) wg)
   x (* (+ fh (fix (/ x0 wg))) wg)
    )
    (while (< y yn)
(setq jdb (pb_jdb (list x y) d))
(setq jds (length jdb) i 0)

(while (< i jds)
  (setq x1 (nth i jdb) x2 (nth (1+ i) jdb))
  (setq pt1 (list x1 y) pt2 (list x2 y))
  (command "line" pt1 (polar pt1 pi (* blc 5)) "")
  (command "line" pt2 (polar pt2 0 (* blc 5)) "")
      (if (< x2 0) (setq fh 0)(setq fh 1))
     
  (setq xx2 (* (+ fh (fix (/ x2 wg))) wg)
  xx xx2
  )
  (while (< xx x1)
(setq pt (list xx y))
(command "line" (polar pt pi (* blc 5)) (polar pt 0 (* blc 5)) "")
(command "line" (polar pt (/ pi 2) (* blc 5)) (polar pt (* pi 1.5) (* blc 5)) "")
(setq xx (+ xx wg))
  )
  (setq i (+ i 2))
)
(setq y (+ y wg))
   )
  ))
  (princ)
)

(defun tk_ok()
  (if (= "1" (get_tile "ty")) (setq ty 1))
  (setq tfm (get_tile "gcmc"))
  (setq chdw (get_tile "chdw"))
  (setq chmj (get_tile "chmj"))
  (setq chrq (get_tile "chrq"))
  (done_dialog)
  (princ)
)

(defun jch()
  (if (= "1" (get_tile "jc"))(mode_tile "ds" 0)(mode_tile "ds" 1))
)

(defun hk()
  (set_tile "size" (strcat "图廓尺寸大小为 " (itoa h) " * " (itoa (+ w dw)) " 毫米"))
)

全部回复(6 )

只看楼主 我来说两句
  • tjchzhh
    tjchzhh 沙发
    太繁杂了,一个市井小书童看不懂
    2010-05-23 16:23:23

    回复 举报
    赞同0
  • huerfei008
    huerfei008 板凳
    我一下也看不出来,我运行这个程序什么反应都没有!
    2007-04-25 12:13:25

    回复 举报
    赞同0
加载更多
这个家伙什么也没有留下。。。

CAD下载及教程

返回版块

52.07 万条内容 · 656 人订阅

猜你喜欢

阅读下一篇

CAD每次打开都要选择“指定字体给样式”怎么回事?

在每次打开CAD图纸的时候,都会弹出一个对话框,“指定字体给样式”而且每次都要选择gbcbig.shx确定好几次后才能显示出图纸来,这个是怎么回事,有谁知道不通过这个直接打开图纸的吗?我把下载的字体覆盖在CAD的安装文件FONTS里面还是不行。

回帖成功

经验值 +10