- 积分
- 58881
- 明经币
- 个
- 注册时间
- 2004-6-15
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
改了改，兼容R14版。 - hjwt:dialog{
-  label="绘制虾壳弯头程序:M6";  
-  :cluster {
-   :row { //建立横列元件
-   :image{key="img";width=36;height=12;color=-3;} //建立影象元件
-   } //关闭横列元件
-   : boxed_column { //带注释框的列,框名:"绘图数据:" 
-   label="绘图数据:";
-   : edit_box {label="输入虾壳弯管外径:";key="DW";edit_width=6;}
-   : edit_box {label="输入虾接弯曲半径:";key="R";edit_width=6;}
-   : edit_box {label="输入虾接弯角角度:";key="V";edit_width=6;}
-   : edit_box {label="输入虾接切分数量:";key="N";edit_width=6;}
-   : button {label="(原点绘图)/拾取>>";key="pick";}
-   }
-  } 
-  : radio_row {
-   key="htfx";
-   value="a0";
-   spacer;
-   :radio_button {label="左上";key="a0";}
-   spacer;
-   :radio_button {label="右上";key="a90";}
-   spacer;
-   :radio_button {label="右下";key="a180";}
-   spacer;
-   :radio_button {label="左下";key="a270";}
-   spacer;
-   :toggle{label="标注";value="1";key="bz";}
-  }
-  ok_cancel;
- }
- ; 绘制虾壳管
- ;程序成功调入提示信息
- (if (> (ATOI (GETVAR "ACADVER")) 18) (setvar "AUTOSNAP" 47)) ;打开极轴
- (if (> (atoi (getvar "ACADVER")) 14) (setvar "osmode" 15359)) ;恢复对象捕捉  
- (princ "\n欢迎使用虾壳管弯头绘制程序,需要启动请敲: hjwt")
- ;;;;;;;;;;取得由对话框输入的关键值模块;;;;;;;;;
- (defun getdata () ;用于取得由对话框输入的关键值  
-  (setq DW (atof (get_tile "DW")) ;抽取对话框D并付值于D
-        R (atof (get_tile "R")) ;抽取对话框R并付值于R
-        V (atof (get_tile "V")) ;抽取对话框V并付值于V
-        N (atof (get_tile "N")) ;抽取对话框N并付值于N
-  )
-  (prin1 (get_tile "bz"))
-  (setq A90 (atoi (get_tile "a90"))
-        A180 (atoi (get_tile "a180"))
-        A270 (atoi (get_tile "a270"))
-        htfx (get_tile "htfx")
-  )
-  (setq bz (atoi (get_tile "bz")))
- )
- ;;;;;;;;;;;标注尺寸;;;;;;;;;
- (defun bzcc ()
-  (command "_dimaligned" PT1 PT3 d1 "_dimaligned" PT4 PT2 d2)
- )
- ;;;;;;;;;;;变化坐标;;;;;;;;
- (defun xgzbx1 () (command "_ucs" "y" "180"))
- (defun xgzbx2 () (command "_ucs" "z" "180"))
- (defun xgzbx3 () (command "_ucs" "x" "180"))
- ;;;;;;;;;;数据处理模块;;;;;;;;
- (defun cal_draw ()
-  (setq Y1 0 ;为变量x1赋初值
-        X1 0 ;为变量y1赋初值
-        pt1 (list X1 Y1) ;将坐标X1,Y1赋给PT1点
-        pt2 (list Y1 X1) ;将坐标Y1,X1赋给PT2点
-        A (- R (/ DW 2))
-        B (+ R (/ DW 2))
-        Y (* (/ (/ V (* (- N 1) 2)) 180) PI)
-        X1 A
-        X2 B
-        Y1 0
-        Y2 0
-        PT1 (list X1 Y1) ;将坐标X1,Y1赋给PT1点
-        PT2 (list X2 Y2) ;将坐标X2,Y2赋给PT2点
-        TT 1
-  )
-  (setvar "osmode" 0) ;关闭对象捕捉
-  (if (= A90 1) (xgzbx1))
-  (if (= A180 1) (xgzbx2))
-  (if (= A270 1) (xgzbx3))
-  (command ".pline" PT1 PT2 "") ;用多义线连接点PT1,PT2
-  (setq A (/ A (cos Y))
-        B (/ B (cos Y))
-  )
-  (while (< TT (* (- N 1) 2)) ;如果TT<(N-1)*2,就执行以下程序
-   (setq X3 (* (cos (* Y TT)) A)
-         y3 (* (sin (* Y TT)) A)
-         X4 (* (cos (* Y TT)) B)
-         y4 (* (sin (* Y TT)) B)
-         pt3 (list X3 Y3) ;将坐标X3,Y3赋给PT3点
-         pt4 (list X4 Y4) ;将坐标X4,Y4赋给PT4点
-         XC1 (/ (+ X1 X2) 2) ;计算点C1的X坐标值
-         XC2 (/ (+ X3 X4) 2) ;计算坐C2的X坐标值
-         YC1 (/ (+ Y1 Y2) 2) ;计算坐C1的Y坐标值
-         YC2 (/ (+ Y3 Y4) 2) ;计算坐C2的Y坐标值
-         C1 (list XC1 YC1) ;将坐标XC1,YC1赋给C1点
-         C2 (list XC2 YC2) ;将坐标XC2,YC2赋给C2点
-   )
-   (command ".pline" PT1 PT3 PT4 PT2 "") ;用多义线连接点PT1,PT3,PT4,PT2
-   (setq Xd1 (- (/ (+ X1 X3) 2) 20) ;计算点d1的X坐标值
-         Xd2 (+ (/ (+ X2 X4) 2) 20) ;计算坐d2的X坐标值
-         Yd1 (- (/ (+ Y1 Y3) 2) 20) ;计算坐d1的Y坐标值
-         Yd2 (+ (/ (+ Y2 Y4) 2) 20) ;计算坐d2的Y坐标值
-         d1 (list Xd1 Yd1) ;将坐标Xd1,Yd1赋给d1点
-        d2 (list Xd2 Yd2) ;将坐标Xd2,Yd2赋给d2点
-   )
-   (command ".line" C1 C2 "") ;用多义线连接点C1,C2
-   ;标注PT1到PT3的距离,标注PT4到PT2的距离
-   (if (= bz 1) (bzcc)) ;如果bz值为1.0,执行bzcc  
-   (setq X1 X3
-         X2 X4
-         Y1 Y3
-         Y2 Y4
-         PT1 PT3
-         PT2 PT4
-         TT (+ TT 2)
-   )
-  )
-  (setq A (- R (/ DW 2))
-        B (+ R (/ DW 2))
-        X3 (* (cos (* (/ V 180) PI)) A)
-        y3 (* (sin (* (/ V 180) PI)) A)
-        X4 (* (cos (* (/ V 180) PI)) B)
-        y4 (* (sin (* (/ V 180) PI)) B)
-        pt3 (list X3 Y3) ;将坐标X3,Y3赋给PT3点
-        pt4 (list X4 Y4) ;将坐标X4,Y4赋给PT4点
-        XC1 (/ (+ X1 X2) 2) ;计算点C1的X坐标值
-        XC2 (/ (+ X3 X4) 2) ;计算坐C2的X坐标值
-        YC1 (/ (+ Y1 Y2) 2) ;计算坐C1的Y坐标值
-        YC2 (/ (+ Y3 Y4) 2) ;计算坐C2的Y坐标值
-        C1 (list XC1 YC1) ;将坐标XC1,YC1赋给C1点
-        C2 (list XC2 YC2) ;将坐标XC2,YC2赋给C2点
-  )
-   ;用直线连接点PT1,PT3,PT4,PT2,C1,C2
-  (command ".Pline" PT1 PT3 PT4 PT2 "" ".line" C1 C2 "")
-  (setq Xd1 (- (/ (+ X1 X3) 2) 20) ;计算点d1的X坐标值
-        Xd2 (+ (/ (+ X2 X4) 2) 20) ;计算坐d2的X坐标值
-        Yd1 (- (/ (+ Y1 Y3) 2) 20) ;计算坐d1的Y坐标值
-        Yd2 (+ (/ (+ Y2 Y4) 2) 20) ;计算坐d2的Y坐标值
-        d1 (list Xd1 Yd1) ;将坐标Xd1,Yd1赋给d1点
-        d2 (list Xd2 Yd2) ;将坐标Xd2,Yd2赋给d2点
-  )
-  (if (= bz 1) (bzcc)) ;如果bz值为1.0,执行bzcc
- )
- ;;;;;;;;;;调取幻灯片;;;;;;;;;
- (defun showsld (stt / sldnm tile_v tile_h)
-  (cond
-   ((= stt "a0") (setq sldnm "htfx0.sld"))
-   ((= stt "a90") (setq sldnm "htfx90.sld"))
-   ((= stt "a180") (setq sldnm "htfx180.sld"))
-   ((= stt "a270") (setq sldnm "htfx270.sld"))
-  )
-  (start_image "img")
-  (setq tile_v (dimy_tile "img")
-         tile_h (dimx_tile "img"))
-  (fill_image 0 0 tile_h tile_v -3)
-  (slide_image 0 0 tile_h tile_v sldnm)
-  (end_image)
- )
- ;;;;;;;;;;;;;主程序模块
- (defun C:hjwt ()
-  (if (> (atoi (getvar "ACADVER")) 18) (setvar "DYNmode" 0)) ;关闭动态输入
-  (setq oldos (getvar "OSMODE"))
-  (setvar "cmdecho" 0) ;关闭命令行回现功能
-  (setq DW 1000 ;给变量赋初值
-         R 1000
-         V 45
-         N 3
-         x 0
-         y 0
-         z 0
-         re 3
-  )
-  (if (> (setq id (load_dialog "hjwt")) 0) (progn ;加载 DCL 文件
-   (while (> re 1)
-   (if (new_dialog "hjwt" id) (progn
-   (set_tile "DW" (rtos DW 2 2))
-   (set_tile "R" (rtos R 2 2))
-   (set_tile "V" (rtos V 2 2))
-   (set_tile "N" (rtos N 2 2))
-   (setq bz (atoi (get_tile "bz")))
-   (setq a90 (get_tile "a90")
-         a180 (get_tile "a180")
-         a270 (get_tile "a270")
-         htfx (get_tile "htfx")
-   )
-   (if (= what 3) (showsld "a0"))
-   (action_tile "htfx" "(showsld $value)")
-   (action_tile "pick" "(done_dialog 2)")
-   (action_tile "accept" "(getdata)(done_dialog 1)")
-   (action_tile "cancel" "(done_dialog 0)")
-   (setq re (start_dialog))
-   (if (= re 2) (progn
-   (initget 1)
-   (setq pt_base (getpoint "\n选取绘图点位置:")
-         x (car pt_base)
-         y (cadr pt_base)
-         z (caddr pt_base)
-   )
-   (setq re 2)
-   ))
-   )
-   (alert "Unable to display dialog box!\n无法显示对话框！")
-   )
-   )
-   (unload_dialog id) ;卸载该对话框
-  )
-   (alert "Unable to load dialog box!\n无法装载对话框！")
-  )
-  (if (= re 1) (progn
-   (setq pt_base (list x y z))
-   (command ".ucs" "o" pt_base)
-   (cal_draw)
-   (PROMPT "\n本次绘图成功!")
-  )
-   (PROMPT "\n您已取消了本次操作!")
-  )
-  (if (> (atoi (getvar "ACADVER")) 14) (setvar "AUTOSNAP" 47)) ;打开极轴
-  (setvar "osmode" oldos) ;恢复对象捕捉
-  (command ".ucs" "w")
-  (princ)
- )
|
|
[复制链接]
发表于 2008-6-27 00:22
置顶卡
变色卡
显身卡
发表于 2008-6-27 09:50
楼主