OpenDcl做的模态对话框应用示例---前方交会计算

牢固

这是OpenDcl做的一个模态对话框应用示例---前方交会计算！先看演示：

它主要展示了OpenDcl 以下几方面的开发应用技巧:
1、模态对话框的加载，以及如何关闭模态对话框后在屏幕取点后操作后，怎样重载对话框！
2、文本框textBox控件、图像控件的使用。
对话框的控制代码：
[pcode=lisp,true](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.))
  )
[/pcode]
对话框文件下载:

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:Forwardinters.odcl 
下载次数:125  文件大小:39.09 KB 
下载权限: 学生 以上  [免费赚D豆]

Lispboy

G版，先给普及下知识呗，啥叫前方交会法？ 这程序是啥专业的干嘛用的~

牢固

Lispboy 发表于 2013-4-25 14:28

                               
登录/注册后可看大图

G版，先给普及下知识呗，啥叫前方交会法？ 这程序是啥专业的干嘛用的~

这是测量里的术语：
定义：在两个已知点A、B上分别对待定点P相互进行水平角观测，测得角α和β，并根据已知点的坐标及观测角值α和β 计算出待定点P坐标的方法。

zhuquanmao

G版功德无量 大放源码

zyhandw

根据G版的程序，先自己做个odcl试试:lol

panziyang000

版主，为什么我试用你的程序加界面，没做任何修改 ，但是出现下面的错误




版主求解答  我自己写的小程序也是这样拿不到值。

牢固

panziyang000 发表于 2013-5-14 14:47
版主，为什么我试用你的程序加界面，没做任何修改 ，但是出现下面的错误

根据提示，应该是对话框没有成功加载！检查下对话框文件是否放在了CAD的支持目录下！

panziyang000

谢谢 问题解决

对你动情

牢固 发表于 2013-5-14 14:58
根据提示，应该是对话框没有成功加载！检查下对话框文件是否放在了CAD的支持目录下！

复制您那代码在CAD2008里怎么试验不行啊？在CAD里输入命令qfjh回车后都没有反应。这是怎么回事啊？

对你动情

你看到我的问题了吗？
复制您那代码在CAD2008里怎么试验不行啊？在CAD里输入命令qfjh回车后都没有反应。这是怎么回事啊？

牢固

对你动情 发表于 2013-6-21 17:09
你看到我的问题了吗？
复制您那代码在CAD2008里怎么试验不行啊？在CAD里输入命令qfjh回车后都没有反应。这 ...

确保已经安装的ODCL,请将代码文件和ODCL对话框文件放在同一CAD搜索路径！

XDnpu349

请问下 不安装ODCL 能调用对话框不？或者要 先加载什么程序？

pmqbwd

谢谢楼主的源码，下载学习。

jyzas

不错，谢谢楼主分享、、

mzq4901

学习了