明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1346|回复: 4

请问这段程序

[复制链接]
发表于 2004-5-28 21:14:00 | 显示全部楼层 |阅读模式
程序是实现行差标注操作的 但红色部分的绘图程序有些问题 请问问题出现在哪? (defun dial1() ;主对话框驱动程序
(if(not(new_dialog "dimention" dcld))(exit))
(start_image "dimg")
(slide_image 0 0 (dimx_tile "dimg")(dimy_tile "dimg") "smain")
(end_image)
(set_tile "heigth" (rtos h 2 2))
(set_tile "name" dimname)
(set_tile "dvalue" dimv)
(action_tile "pheight" "(done_dialog 3)")
(action_tile "pickp" "(getmain)(dial2)")
(action_tile "accept" "(getmain)(done_dialog 1)")
(action_tile "cancel" "(done_dialog -1)")
)
(defun dial2() ;选项对话框驱动程序
(if(not(new_dialog "dpoint" dcld))(exit))
(start_image "pimg")
(slide_image 0 0 (dimx_tile "pimg")(dimy_tile "pimg") "spoint")
(end_image)
(set_tile "p1x" (rtos x1 2 2))
(set_tile "p1y" (rtos y1 2 2))
(set_tile "p2x" (rtos x2 2 2))
(set_tile "p2y" (rtos y2 2 2))
(action_tile "pickp1" "(done_dialog 6)")
(action_tile "dimsnap" "(setq osmode(atoi $ value))")
(action_tile "pickp2" "(done_dialog 7)")
(action_tile "accept" "(getpon)(done_dialog 4 )")
(action_tile "cancel" "(done_dialog 5)")
(setq retv (start_dialog))
(if(= retv 6)(done_dialog 6))
(if(= retv 7)(done_dialog 7))
)
(defun getmain() ;获取对话框控件属性值
(setq dimname(get_tile "name"))
(setq dimv(get_tile "dvalue"))
(setq h (atof (get_tile "height")))
)
(defun getpon() ;获取编辑中点的坐标值
(setq x1 (atof (get_tile "p1x")))
(setq y1 (atof (get_tile "p1y")))
(setq x2 (atof (get_tile "p2x")))
(setq y2 (atof (get_tile "p2y")))
(setq p1 (list x1 y1 0) p2(list x2 y2 0))
)
(defun mvdraw() ;绘图程序
(setq xm x1)
(setq ym y2)
(setq m (list xm ym))
(setq la (strlen dimv))
(setq lb (strlen dimname))
(setq 1 (+ 1 la lb))
(setq 1 (* h 1))
(setvar "SNAPMODE" osmode)
(if(< = x1 x2 )(setq xa x2)(setq xa (+ x2 1)))
(setq ya (+ y2 (* 0.8 h )))
(setq xc (- xa 1))
(setq yc (- y2 (* 0.8 h)))
(setq a (list xa ya ))
(setq c (list xc yc))
(setq arh (* 0.5 h))
(setq ymp (* 1 h))
(if(< y2 y1)(setq ymp (- 0 ymp)))
(setq ymp (+ ymp y1))
(setq mp (list x1 ymp))
(setq j (list(+ xc (* 1 h)) yc))
(setq k (list(- xa (* (strlen dimname) h)) ya))
(command "pline" p1 "w" 0 arh mp "")
(command "line" mp m p2 "")
(command "rectang" a c)
(command "text" (list (+ (car c) 2)(+ (cadr c) 2)) h 0 " % % c")
(command "rectang" j (list (- (car k) 2) ya))
(command "text" (list (+ (car j) 4)(+ yc 2)) h 0 dimv)
(command "text" (list (car k)(+ yc 2)) h 0 dimname)
)
(defun c:mydim() ;主程序,添加绘图命令
(setq dcld (load_dialog "hc2.dcl"))
(if(< dcld 0)(exit))
(setq x1 45 y1 45 x2 90 y2 90 retv 3 h 12)
(setq dimname "M" dimv "009")
(setq p1(list x1 y1 0) p2(list x2 y2 0))
(while(> retv 1)
(dial1)
(if(or(= retv 6)(= retv 7))(dial2))
(if(and(and(/= retv 1)(/= retv -1))(/= retv 6)(/= retv 7))
(setq retv(start_dialog))
)
(if(= retv 3)(setq h (getdist "Charactor Height \n")))
(if(= retv 6)
(setq p1 (getpoint "Point P1: \n") x1 (car p1) y1(cadr p1))
)
(if(= retv 7)
(setq p2 (getpoint "Point P2:\n") x2 (car p2) y2 (cadr p2))
)
)
(unload_dialog dcld)
(if(= retv 1) (mvdraw))
(princ)
)
发表于 2004-5-28 21:44:00 | 显示全部楼层
对话框呢?你说有问题,又是什么问题呢?为什么不描述一下问题???
发表于 2004-5-28 21:45:00 | 显示全部楼层
where is your dcl file?
 楼主| 发表于 2004-5-30 10:31:00 | 显示全部楼层
对不起,没有把问题说清楚。 问题:对话框里的标注图出不来 dcl文件为: dimention :dialog{
label="行差标注";
:row{
width=42;
:image{
width=30;
height=8;
key="dimg";
color=-2;
}
:boxed_column{
label="数据项";
width=12;
:row{
:edit_box{
label="字体高度&H";
key="height";
width=4;
value="12";
}
:button{
label="光标指定(&D)<";
width=4;
key="pheight";
}
}
:edit_box{
label="标注名称&N";
key="name";
width=8;
value="A";
}
:edit_box{
label="标注行差&V";
key="dvalue";
width=8;
value="002";
}
:button{
label="选取点项(&)...";
key="pickp";
mnemonic="J";
}
}
}
ok_cancel;
}
dpoint:dialog{
label="标注对象";
:row{
:image{
width=30;
key="pimg";
height=8;
color=0;
}
:column{
:toggle{
label="捕捉";
key="dimsnap";
value="1";
}
:row{
:column{
:edit_box{
label="P1(&X)";
key="p1x";
value="45";
}
:edit_box{
label="P1(&Y)";
key="p1y";
value="45";
}
:button{
label="拾起P1点(&F)<";
key="pickp1";
}
}
:column{
:edit_box{
label="P2(&X)";
key="p2x";
value="90";
}
:edit_box{
label="P2(&Y)";
key="p2y";
value="90";
}
:button{
label="拾起P2点(&S)<";
key="pickp2";
}
}
}
}
}
ok_cancel;
}
发表于 2004-5-30 10:53:00 | 显示全部楼层
这里是怎么回事? (setq 1 (+ 1 la lb))
(setq 1 (* h 1))
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-10-1 08:17 , Processed in 0.184943 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表