OpenDcl做的模态对话框应用示例---前方交会计算
本帖最后由 牢固 于 2013-4-25 14:23 编辑这是OpenDcl做的一个模态对话框应用示例---前方交会计算！先看演示：
它主要展示了OpenDcl 以下几方面的开发应用技巧:
1、模态对话框的加载，以及如何关闭模态对话框后在屏幕取点后操作后，怎样重载对话框！
2、文本框textBox控件、图像控件的使用。
对话框的控制代码：
(defun gxl-AutoLoadODclArx(/ loaded fn v fnn)
;;系统已安装OpenDcl的加载方式
(if (and
(not dcl_getversionex) ;_ OpenDcl未加载
(= 2 (boole 1 (getvar "DEMANDLOAD") 2))
)
(VL-CATCH-ALL-APPLY 'vl-cmdf (list "opendcl")) ;_ 调用OpenDcl命令加载OpenDcl
)
(if (not dcl_getversionex) ;_ OpenDcl仍未加载
;;按AutoCAD的不同版本搜索opendcl.arx文件进行加载
(cond
((= "16" (setq v (itoa (atoi (getvar 'acadver)))))
(if
(setq fnn (findfile (setq fn (strcat "opendcl." v ".arx"))))
(setq loaded (arxload fnn "1"))
(setq loaded "2")
)
)
((or (= "17" v) (= "18" v) (= "19" v))
(if (= "x86" (getenv "PROCESSOR_ARCHITECTURE")) ;_ 32位系统
(if (setq fnn
(findfile (setq fn (strcat "opendcl." v ".arx")))
)
(setq loaded (arxload fnn "1"))
(setq loaded "2")
)
;;64位系统
(if (setq fnn
(findfile (setq fn (strcat "opendcl." v "x64.arx")))
)
(setq loaded
(arxload fnn
"1"
)
)
(setq loaded "2")
)
)
)
(t (Setq loaded "2"))
)
(setq loaded "3") ;_ 已加载
)
;; 加载OpenDcl失败，直接中断程序
(if (= "1" loaded)
(progn
(princ (strcat fn "加载失败！程序将退出！"))
(exit)
)
(if (= "2" loaded)
(progn
(princ
(strcat "未找到对应的\"" fn "\"文件！程序将退出！"))
(exit)
)
)
)
;;返回3，表示加载成功
loaded
)
;;(gxl-Load_ODCL_Project projname reload password alias)
;;功能：加载OpenDcl工程
;;参数：projname = 工程名称字串(后缀为"*.odcl"、"*.odcl.lsp"或不带后缀)或者OpenDcl工程数据表
;; reload =T 强制重载工程 or nil 若已加载，则什么也不干
;; password = 设定密码字串 or nil
;; alias = 替代项目关键字 or nil
;; By Gu_xl
(defun gxl-Load_ODCL_Project
(projname reload password alias / bytes rtype Projects e)
(cond
((null dcl_project_import)
(princ "需OpenDCL 5.0 以上版本支持.\n")
nil
)
((= 'list (type projname)) ;_ projname 为OpenDcl工程数据表
(dcl_project_import projname password alias)
)
((and
(progn
(if (= ".LSP"
(substr (strcase projname) (- (strlen projname) 3))
)
(setq projname (substr projname 1 (- (strlen projname) 4)))
)
(if (/= ".ODCL"
(substr (strcase projname) (- (strlen projname) 4))
)
(setq projname (strcat projname ".odcl"))
)
(setq bytes (vl-get-resource projname))
)
(eq 'str (setq rtype (type bytes)))
(not (eq "" bytes))
) ;_ 从打包的资源文件中读取OpenDCL工程
(if reload
(dcl_project_import bytes password alias)
(if (or
(not (setq Projects (dcl_GetProjects)))
(not (member (strcase (vl-filename-base projname))
(mapcar 'strcase Projects)
)
)
)
(dcl_project_import bytes password alias)
)
)
)
;;查找OpenDCL工程文件进行加载
((if (not (VL-CATCH-ALL-ERROR-P
(setq e (VL-CATCH-ALL-APPLY
'dcl_project_load
(list (findfile projname) reload alias)
)
)
)
)
e
)
)
)
)
;;以上两个通用函数函数请放在任何一个OpenDcl程序的最开始，
;;前方交汇计算 By Gu_xl 2013年4月24日
(princ "\n前方交汇计算 命令:QFJH By Gu_xl 2013年4月24日")
(defun c:qfjh()
;;自动加载OpenDcl Arx插件
(gxl-AutoLoadODclArx)
;;(gxl-Load_ODCL_Project projname reload password alias)
;;功能：加载OpenDcl工程
;;参数：projname = 工程名称字串(后缀为"*.odcl"、"*.odcl.lsp"或不带后缀)或者OpenDcl工程数据表
;; reload =T 强制重载工程 or nil 若已加载，则什么也不干
;; password = 设定密码字串 or nil
;; alias = 替代项目关键字 or nil
(gxl-Load_ODCL_Project "Forwardinters.odcl" nil nil nil)
;;以上两个函数见 http://www.xdcad.net/forum/forum ... 7468&extra=page%3D1
;; 设置标识变量*Open_Forwardinters_Form1为nil
(setq *Open_Forwardinters_Form1 nil)
;;显示对话框
(dcl_form_show Forwardinters_Form1)
;;模态对话框结束后执行如下代码
;;根据*Open_Forwardinters_Form1值判断是否重新打开对话框
(while *Open_Forwardinters_Form1
(setq *pt (getpoint "\n选点:")) ;_ 屏幕取点
(dcl_form_show Forwardinters_Form1) ;_ 重新显示对话框
)
;;回收数据内存
(setq *Open_Forwardinters_Form1 nil *pt nil)
(princ)
)
;;对话框初始化
(defun c:Forwardinters_Form1_OnInitialize (/)
(dcl_Control_SetEnabled Forwardinters_Form1_TextButton1 nil) ;_ 禁用按钮
(dcl_Control_SetEnabled Forwardinters_Form1_TextButton3 nil) ;_ 禁用按钮
(if (and *Open_Forwardinters_Form1
*pt
) ;_ 屏幕取点后坐标文本框赋值
(cond
((= "基点A" *Open_Forwardinters_Form1)
(dcl_Control_SetText Forwardinters_Form1_TextBox5 (rtos (car *pt) 2 4)) ;_ 横坐标
(dcl_Control_SetText Forwardinters_Form1_TextBox4 (rtos (cadr *pt) 2 4)) ;_ 纵坐标
)
((= "基点B" *Open_Forwardinters_Form1)
(dcl_Control_SetText Forwardinters_Form1_TextBox9 (rtos (car *pt) 2 4)) ;_ 横坐标
(dcl_Control_SetText Forwardinters_Form1_TextBox8 (rtos (cadr *pt) 2 4)) ;_ 纵坐标
)
)
)
;;执行检查计算按钮是否显示
(Forwardinters_CheckinputBox)
)
;;坐标角度输入值变化后执行检查计算按钮是否显示
(defun Forwardinters_CheckinputBox ()
(if (and
(/= "" (dcl_Control_GetText Forwardinters_Form1_TextBox4))
(/= "" (dcl_Control_GetText Forwardinters_Form1_TextBox5))
(/= "" (dcl_Control_GetText Forwardinters_Form1_TextBox6))
(/= "" (dcl_Control_GetText Forwardinters_Form1_TextBox8))
(/= "" (dcl_Control_GetText Forwardinters_Form1_TextBox9))
(/= "" (dcl_Control_GetText Forwardinters_Form1_TextBox10))
)
(progn
(dcl_Control_SetEnabled Forwardinters_Form1_TextButton1 t)
(if (and
(/= "" (dcl_Control_GetText Forwardinters_Form1_TextBox15))
(/= "" (dcl_Control_GetText Forwardinters_Form1_TextBox19))
)
(dcl_Control_SetEnabled Forwardinters_Form1_TextButton3 t)
(dcl_Control_SetEnabled Forwardinters_Form1_TextButton3 nil)
)
)
(progn
(dcl_Control_SetEnabled Forwardinters_Form1_TextButton1 nil) ;_ 禁用计算按钮
(dcl_Control_SetEnabled Forwardinters_Form1_TextButton3 nil) ;_ 禁用绘制按钮
)
)
)
;;计算交汇点坐标
(defun Forwardinters_cal (/ A B C XA XB D YB YA E F G H I J K L)
(setq a (GXL-NUM-TAN (GXL-NUM-DMS2R (atof (dcl_Control_GetText Forwardinters_Form1_TextBox6))))) ;_ tanα
(dcl_Control_SetText Forwardinters_Form1_TextBox7 (rtos a 2 6)) ;_ 显示 tanα
(setq b (GXL-NUM-TAN (GXL-NUM-DMS2R (atof (dcl_Control_GetText Forwardinters_Form1_TextBox10))))) ;_ tanβ
(dcl_Control_SetText Forwardinters_Form1_TextBox11 (rtos a 2 6)) ;_ 显示 tanβ
(setq c (- (setq XA (atof (dcl_Control_GetText Forwardinters_Form1_TextBox4)))
(setq XB (atof (dcl_Control_GetText Forwardinters_Form1_TextBox8)))
)
) ;_ XA-XB
(dcl_Control_SetText Forwardinters_Form1_TextBox20 (rtos c 2 6)) ;_ 显示 XA-XB
(setq d (- (setq YB (atof (dcl_Control_GetText Forwardinters_Form1_TextBox9)))
(setq YA (atof (dcl_Control_GetText Forwardinters_Form1_TextBox5)))
)
) ;_ YB-YA
(dcl_Control_SetText Forwardinters_Form1_TextBox21 (rtos d 2 6)) ;_ 显示 YB-YA
(setq e (* a b)) ;_ (1)= tanα×tanβ
(dcl_Control_SetText Forwardinters_Form1_TextBox22 (rtos e 2 6)) ;_ 显示 (1)= tanα×tanβ
(setq f (+ a b)) ;_ (2)= tanα×tanβ
(dcl_Control_SetText Forwardinters_Form1_TextBox23 (rtos f 2 6)) ;_ 显示 (2)= tanα+tanβ
(setq g (* a XA)) ;_ (3)=XA×tanα
(dcl_Control_SetText Forwardinters_Form1_TextBox12 (rtos g 2 6)) ;_ 显示 (3)=XA×tanα
(setq h (* b XB)) ;_ (4)=XB×tanβ
(dcl_Control_SetText Forwardinters_Form1_TextBox13 (rtos h 2 6)) ;_ 显示 (4)=XB×tanβ
(setq i (* d e)) ;_ (5)=(YB-YA)×(1)
(dcl_Control_SetText Forwardinters_Form1_TextBox14 (rtos i 2 6)) ;_ 显示 (5)=(YB-YA)×(1)
(setq j (* a YA)) ;_ (6)=YA×tanα
(dcl_Control_SetText Forwardinters_Form1_TextBox16 (rtos j 2 6)) ;_ 显示 (6)=YA×tanα
(setq k (* b YB)) ;_ (7)=YB×tanβ
(dcl_Control_SetText Forwardinters_Form1_TextBox17 (rtos k 2 6)) ;_ 显示 (7)=YB×tanβ
(setq l (* c e)) ;_ (8)=(XA-XB)×(1)
(dcl_Control_SetText Forwardinters_Form1_TextBox18 (rtos l 2 6)) ;_ 显示 (8)=(XA-XB)×(1)
;;计算交会点的纵坐标
(dcl_Control_SetText Forwardinters_Form1_TextBox15 (rtos (/ (+ g h i) f) 2 3));_ XP=[(3)+(4)+(5)]÷(2)
;;计算交会点的横坐标
(dcl_Control_SetText Forwardinters_Form1_TextBox19 (rtos (/ (+ j k l) f) 2 3));_ YP=[(3)+(4)+(5)]÷(2)
)
;;计算交会坐标按钮动作
(defun c:Forwardinters_Form1_TextButton1_OnClicked (/)
(Forwardinters_cal)
(dcl_Control_SetEnabled Forwardinters_Form1_TextButton3 t) ;_ 启用绘制按钮
)
;;将计算图绘制到CAD
(defun c:Forwardinters_Form1_TextButton3_OnClicked (/ A B P NA NB NP)
(command "pline"
"_non"
(setq
p (strcat (dcl_Control_GetText Forwardinters_Form1_TextBox19)
","
(dcl_Control_GetText Forwardinters_Form1_TextBox15)
)
)
"_non"
(setq A (strcat (dcl_Control_GetText Forwardinters_Form1_TextBox5)
","
(dcl_Control_GetText Forwardinters_Form1_TextBox4)
)
)
"_non"
(setq B (strcat (dcl_Control_GetText Forwardinters_Form1_TextBox9)
","
(dcl_Control_GetText Forwardinters_Form1_TextBox8)
)
)
"c"
)
(setq NA (dcl_Control_GetText Forwardinters_Form1_TextBox1)
NB (dcl_Control_GetText Forwardinters_Form1_TextBox2)
NP (dcl_Control_GetText Forwardinters_Form1_TextBox3)
)
(if (= "" NA) (setq NA "已知点A"))
(if (= "" NB) (setq NB "已知点B"))
(if (= "" NP) (setq NP "交会点P"))
(command "text" "_non" A 2 0 NA
"text" "_non" B 2 0 NB
"text" "_non" P 2 0 NP
"circle" "_non" A 1
"circle" "_non" B 1
"circle" "_non" P 1
)
)
;;退出按钮
(defun c:Forwardinters_Form1_TextButton2_OnClicked (/)
(setq *Open_Forwardinters_Form1 nil)
(dcl_form_close Forwardinters_Form1)
)
;;纵坐标XA输入
(defun c:Forwardinters_Form1_TextBox4_OnEditChanged (NewValue /)
(Forwardinters_CheckinputBox)
)
;;横坐标YA输入
(defun c:Forwardinters_Form1_TextBox5_OnEditChanged (NewValue /)
(Forwardinters_CheckinputBox)
)
;;α（°′″）输入
(defun c:Forwardinters_Form1_TextBox6_OnEditChanged (NewValue /)
(Forwardinters_CheckinputBox)
)
;;纵坐标XB输入
(defun c:Forwardinters_Form1_TextBox8_OnEditChanged (NewValue /)
(Forwardinters_CheckinputBox)
)
;;横坐标YB输入
(defun c:Forwardinters_Form1_TextBox9_OnEditChanged (NewValue /)
(Forwardinters_CheckinputBox)
)
;;β（°′″）输入
(defun c:Forwardinters_Form1_TextBox10_OnEditChanged (NewValue /)
(Forwardinters_CheckinputBox)
)
;;纵坐标XP
(defun c:Forwardinters_Form1_TextBox15_OnEditChanged (NewValue /)
(Forwardinters_CheckinputBox)
)
;;纵坐标YP
(defun c:Forwardinters_Form1_TextBox19_OnEditChanged (NewValue /)
(Forwardinters_CheckinputBox)
)
;;图中取基点A坐标
(defun c:Forwardinters_Form1_GraphicButton1_OnClicked (/)
(setq *Open_Forwardinters_Form1 "基点A")
(dcl_form_close Forwardinters_Form1)
)
(defun c:Forwardinters_Form1_GraphicButton2_OnClicked (/)
(setq *Open_Forwardinters_Form1 "基点B")
(dcl_form_close Forwardinters_Form1)
)
;;用到的函数
;;;gxl-Num-Tan 角度的正切值，角度为弧度
(defun gxl-Num-Tan (ang)
(if (not (equal 0. (cos ang) 1e-8)) (/ (sin ang) (cos ang)))
)
;;;(gxl-num-dms2R dms) 度分秒转化为弧度
;;(gxl-num-dms2R 0.6)
(defun gxl-num-dms2R(dms / d m s tmp)
(setq d (fix dms))
(setq m (fix (setq tmp (- (* 100 dms) (* 100 d)))))
(setq s (- (* 100 tmp) (* 100 m)))
(setq dms (+ d (/ m 60.) (/ s 3600.)))
(* pi (/ dms 180.))
)
对话框文件下载:
G版，先给普及下知识呗，啥叫前方交会法？ 这程序是啥专业的干嘛用的~ Lispboy 发表于 2013-4-25 14:28 static/image/common/back.gif
G版，先给普及下知识呗，啥叫前方交会法？ 这程序是啥专业的干嘛用的~
这是测量里的术语：
定义：在两个已知点A、B上分别对待定点P相互进行水平角观测，测得角α和β，并根据已知点的坐标及观测角值α和β 计算出待定点P坐标的方法。
G版功德无量 大放源码 根据G版的程序，先自己做个odcl试试:lol 版主，为什么我试用你的程序加界面，没做任何修改 ，但是出现下面的错误
版主求解答我自己写的小程序也是这样拿不到值。
panziyang000 发表于 2013-5-14 14:47
版主，为什么我试用你的程序加界面，没做任何修改 ，但是出现下面的错误
根据提示，应该是对话框没有成功加载！检查下对话框文件是否放在了CAD的支持目录下！ 谢谢 问题解决 牢固 发表于 2013-5-14 14:58
根据提示，应该是对话框没有成功加载！检查下对话框文件是否放在了CAD的支持目录下！
复制您那代码在CAD2008里怎么试验不行啊？在CAD里输入命令qfjh回车后都没有反应。这是怎么回事啊？ 你看到我的问题了吗？
复制您那代码在CAD2008里怎么试验不行啊？在CAD里输入命令qfjh回车后都没有反应。这是怎么回事啊？ 对你动情 发表于 2013-6-21 17:09
你看到我的问题了吗？
复制您那代码在CAD2008里怎么试验不行啊？在CAD里输入命令qfjh回车后都没有反应。这 ...
确保已经安装的ODCL,请将代码文件和ODCL对话框文件放在同一CAD搜索路径！
请问下 不安装ODCL 能调用对话框不？或者要 先加载什么程序？
谢谢楼主的源码，下载学习。 不错，谢谢楼主分享、、 学习了{:1_1:}{:1_1:}{:1_1:}{:1_1:}{:1_1:}{:1_1:}
页:
[1]
2