ODCL非模态对话框运行时CAD总是崩溃

sheoh

如题，ODCL非模态对话框运行时CAD总是崩溃，改为模态对话框就没问题了，不知道为什么。初次接触非模态对话框，不太了解，请多指教。

2. (DEFUN C:LZJS1 (/ old_cmd)
   
3.   (setq pt1 nil pt2 nil pt3 nil Di nil Ang nil LXHZ nil)
   
4.   (setq old_cmd (getvar "cmdecho"))
   
5.   (setvar "cmdecho" 0)      ;关闭命令回显
   
6.   (LZJS_STEP0)
   
7.   (setvar "cmdecho" old_cmd)
   
8. )
   
9. (defun LZJS_STEP0 (/)
   
10.   (if (= (tblobjname "style" "LHZ") nil) ;检查文字样式是否存在
    
11.     (command "-style" "LHZ" "txt.shx" "300" "1" "0" "N" "N" "N")
    
12.   )
    
13.   (if (and (setq pt1 (getpoint "\n选择第一点: "))
    
14.      (setq pt2 (getpoint pt1 "\n选择第二点: "))
    
15.       )
    
16.     (progn
    
17. 
    
18.       (setq Di (distance pt1 pt2))
    
19.       (setq Ang (angle pt1 pt2))
    
20.       (LZJS_STEP0_0)
    
21.     )
    
22.   )
    
23. )
    
24. (defun LZJS_STEP0_0 (/ )
    
25.   (command "opendcl")
    
26.   (dcl_Project_Load "LZJS" T)
    
27.   (dcl_Form_Show LZJS_Form1)
    
28. 
    
29. )
    
30.           ;初始化对话框Form1
    
31. (defun c:LZJS/Form1#OnInitialize (/)  
    
32.   (dcl_Control_SetText LZJS_Form1_TextBox1 (rtos Di 2 0))
    
33.   ;|(dcl_Control_SetText LZJS_Form1_TextBox2 (rtos WallH 2 0))
    
34.   (dcl_Control_SetText LZJS_Form1_TextBox3 (rtos WallF 2 2))
    
35.   (dcl_Control_SetText LZJS_Form1_TextBox4 (rtos DW1W 2 0))
    
36.   (dcl_Control_SetText LZJS_Form1_TextBox5 (rtos DW1H 2 0))
    
37.   (dcl_Control_SetText LZJS_Form1_TextBox6 (rtos DW2W 2 0))
    
38.   (dcl_Control_SetText LZJS_Form1_TextBox7 (rtos DW2H 2 0))
    
39.   (dcl_Control_SetText LZJS_Form1_TextBox8 (rtos DW3W 2 0))
    
40.   (dcl_Control_SetText LZJS_Form1_TextBox9 (rtos DW3H 2 0))
    
41.   (dcl_Control_SetText LZJS_Form1_TextBox10 (rtos DWF 2 2))
    
42.   (dcl_Control_SetText LZJS_Form1_TextBox11 (rtos TextH 2 0))|;
    
43. )
    
44.           ;点击确定按钮后执行命令
    
45. (defun c:LZJS/Form1/TextButton1#OnClicked (/)
    
46.   (setq WallH (atof (dcl_Control_GetText LZJS_Form1_TextBox2)))
    
47.   (setq WallF (atof (dcl_Control_GetText LZJS_Form1_TextBox3)))
    
48.   (setq DW1W (atof (dcl_Control_GetText LZJS_Form1_TextBox4)))
    
49.   (setq DW1H (atof (dcl_Control_GetText LZJS_Form1_TextBox5)))
    
50.   (setq DW2W (atof (dcl_Control_GetText LZJS_Form1_TextBox6)))
    
51.   (setq DW2H (atof (dcl_Control_GetText LZJS_Form1_TextBox7)))
    
52.   (setq DW3W (atof (dcl_Control_GetText LZJS_Form1_TextBox8)))
    
53.   (setq DW3H (atof (dcl_Control_GetText LZJS_Form1_TextBox9)))
    
54.   (setq DWF (atof (dcl_Control_GetText LZJS_Form1_TextBox10)))
    
55.   (setq TextH (atof (dcl_Control_GetText LZJS_Form1_TextBox11)))
    
56.   (dcl_Form_Close LZJS_Form1 1)
    
57. 
    
58.   (setq pt3 (polar pt1 Ang (* 0.5 Di)))
    
59.   (setq DW1A (* DW1W DW1H))
    
60.   (setq DW2A (* DW2W DW2H))
    
61.   (setq DW3A (* DW3W DW3H))
    
62.   (setq DWarea (+ DW1A DW2A DW3A))
    
63.   (setq  LXHZ (/  (+ (* WallF (- (* Di WallH) DWarea)) (* DWF DWarea))
    
64.     (* 1000 Di)
    
65.        )
    
66.   )
    
67.   (if (= (tblobjname "layer" "梁荷载") nil) ;检查图层是否存在
    
68.     (progn
    
69.       (entmake (list      ;创建图层
    
70.      '(0 . "LAYER")
    
71.      '(100 . "AcDbSymbolTableRecord")
    
72.      '(100 . "AcDbLayerTableRecord")
    
73.      '(6 . "CONTINUOUS")
    
74.      '(62 . 1)
    
75.      '(70 . 0)
    
76.      (cons 2 "梁荷载")
    
77.          )
    
78.       )
    
79.     )
    
80.   )
    
81.   (entmake (list '(0 . "TEXT")
    
82.      (cons 1 (rtos LXHZ 2 1))
    
83.      (cons 8 "梁荷载")
    
84.      (cons 7 "LHZ")
    
85.      (cons 10 pt3)
    
86.      (cons 40 TextH)
    
87.      (cons 11 pt3)
    
88.      (cons 50 Ang)
    
89.      (cons 72 1)
    
90.      (cons 73 1)
    
91.      )
    
92.   )
    
93.   (entmake
    
94.     (list
    
95.       '(0 . "LWPOLYLINE")   
    
96.       '(100 . "AcDbEntity")
    
97.       '(100 . "AcDbPolyline")
    
98.       '(90 . 2)   
    
99.       '(70 . 0)
    
100.       (cons 8 "梁荷载")
     
101.       (cons 43 100)
     
102.       (cons 10 (list (car pt1) (cadr pt1)))
     
103.       (cons 10 (list (car pt2) (cadr pt2)))
     
104.       (cons 210 '(0 0 1))
     
105.     )
     
106.   )
     
107. )
     
108.           ;点击取消按钮后退出程序
     
109. (defun c:LZJS/Form1/TextButton2#OnClicked (/)
     
110.   (dcl_Form_Close LZJS_Form1 1)
     
111.   (setvar "cmdecho" old_cmd)
     
112.   (gc)
     
113.   (exit)
     
114. )
     
115. 
     
116. 
     
117. 
     
118. 
     
119. ;;;___________________________________________________________________________________________***
     
120. (princ "\n【梁载计算】加载成功!\n")
     
121. (princ "=============================================*\n")
     
122. (princ "      修改记录                               *\n")
     
123. (princ "日期：sheoh 于 2014-04-24                    *\n")
     
124. (princ "=============================================*\n")
     
125. (princ "欢迎使用【梁载计算】程序,程序命令为:LZJS")
     
126. (prin1)
     
127. ;;;___________________________________________________________________________________________***

(DEFUN C:LZJS1 (/ old_cmd)<br />   (setq pt1 nil pt2 nil pt3 nil Di nil Ang nil LXHZ nil)<br />   (setq old_cmd (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)      ;关闭命令回显<br />   (LZJS_STEP0)<br />   (setvar "cmdecho" old_cmd)<br /> )<br /> (defun LZJS_STEP0 (/)<br />   (if (= (tblobjname "style" "LHZ") nil) ;检查文字样式是否存在<br />     (command "-style" "LHZ" "txt.shx" "300" "1" "0" "N" "N" "N")<br />   )<br />   (if (and (setq pt1 (getpoint "\n选择第一点: "))<br />      (setq pt2 (getpoint pt1 "\n选择第二点: "))<br />       )<br />     (progn<br /> <br />       (setq Di (distance pt1 pt2))<br />       (setq Ang (angle pt1 pt2))<br />       (LZJS_STEP0_0)<br />     )<br />   )<br /> )<br /> (defun LZJS_STEP0_0 (/ )<br />   (command "opendcl")<br />   (dcl_Project_Load "LZJS" T)<br />   (dcl_Form_Show LZJS_Form1)<br /> <br /> )<br />           ;初始化对话框Form1<br /> (defun c:LZJS/Form1#OnInitialize (/)  <br />   (dcl_Control_SetText LZJS_Form1_TextBox1 (rtos Di 2 0))<br />   ;|(dcl_Control_SetText LZJS_Form1_TextBox2 (rtos WallH 2 0))<br />   (dcl_Control_SetText LZJS_Form1_TextBox3 (rtos WallF 2 2))<br />   (dcl_Control_SetText LZJS_Form1_TextBox4 (rtos DW1W 2 0))<br />   (dcl_Control_SetText LZJS_Form1_TextBox5 (rtos DW1H 2 0))<br />   (dcl_Control_SetText LZJS_Form1_TextBox6 (rtos DW2W 2 0))<br />   (dcl_Control_SetText LZJS_Form1_TextBox7 (rtos DW2H 2 0))<br />   (dcl_Control_SetText LZJS_Form1_TextBox8 (rtos DW3W 2 0))<br />   (dcl_Control_SetText LZJS_Form1_TextBox9 (rtos DW3H 2 0))<br />   (dcl_Control_SetText LZJS_Form1_TextBox10 (rtos DWF 2 2))<br />   (dcl_Control_SetText LZJS_Form1_TextBox11 (rtos TextH 2 0))|;<br /> )<br />           ;点击确定按钮后执行命令<br /> (defun c:LZJS/Form1/TextButton1#OnClicked (/)<br />   (setq WallH (atof (dcl_Control_GetText LZJS_Form1_TextBox2)))<br />   (setq WallF (atof (dcl_Control_GetText LZJS_Form1_TextBox3)))<br />   (setq DW1W (atof (dcl_Control_GetText LZJS_Form1_TextBox4)))<br />   (setq DW1H (atof (dcl_Control_GetText LZJS_Form1_TextBox5)))<br />   (setq DW2W (atof (dcl_Control_GetText LZJS_Form1_TextBox6)))<br />   (setq DW2H (atof (dcl_Control_GetText LZJS_Form1_TextBox7)))<br />   (setq DW3W (atof (dcl_Control_GetText LZJS_Form1_TextBox8)))<br />   (setq DW3H (atof (dcl_Control_GetText LZJS_Form1_TextBox9)))<br />   (setq DWF (atof (dcl_Control_GetText LZJS_Form1_TextBox10)))<br />   (setq TextH (atof (dcl_Control_GetText LZJS_Form1_TextBox11)))<br />   (dcl_Form_Close LZJS_Form1 1)<br /> <br />   (setq pt3 (polar pt1 Ang (* 0.5 Di)))<br />   (setq DW1A (* DW1W DW1H))<br />   (setq DW2A (* DW2W DW2H))<br />   (setq DW3A (* DW3W DW3H))<br />   (setq DWarea (+ DW1A DW2A DW3A))<br />   (setq  LXHZ (/  (+ (* WallF (- (* Di WallH) DWarea)) (* DWF DWarea))<br />     (* 1000 Di)<br />        )<br />   )<br />   (if (= (tblobjname "layer" "梁荷载") nil) ;检查图层是否存在<br />     (progn<br />       (entmake (list      ;创建图层<br />      '(0 . "LAYER")<br />      '(100 . "AcDbSymbolTableRecord")<br />      '(100 . "AcDbLayerTableRecord")<br />      '(6 . "CONTINUOUS")<br />      '(62 . 1)<br />      '(70 . 0)<br />      (cons 2 "梁荷载")<br />          )<br />       )<br />     )<br />   )<br />   (entmake (list '(0 . "TEXT")<br />      (cons 1 (rtos LXHZ 2 1))<br />      (cons 8 "梁荷载")<br />      (cons 7 "LHZ")<br />      (cons 10 pt3)<br />      (cons 40 TextH)<br />      (cons 11 pt3)<br />      (cons 50 Ang)<br />      (cons 72 1)<br />      (cons 73 1)<br />      )<br />   )<br />   (entmake<br />     (list<br />       '(0 . "LWPOLYLINE")    <br />       '(100 . "AcDbEntity")<br />       '(100 . "AcDbPolyline")<br />       '(90 . 2)    <br />       '(70 . 0)<br />       (cons 8 "梁荷载")<br />       (cons 43 100)<br />       (cons 10 (list (car pt1) (cadr pt1)))<br />       (cons 10 (list (car pt2) (cadr pt2)))<br />       (cons 210 '(0 0 1))<br />     )<br />   )<br /> )<br />           ;点击取消按钮后退出程序<br /> (defun c:LZJS/Form1/TextButton2#OnClicked (/)<br />   (dcl_Form_Close LZJS_Form1 1)<br />   (setvar "cmdecho" old_cmd)<br />   (gc)<br />   (exit)<br /> )<br /> <br /> <br /> <br /> <br /> ;;;___________________________________________________________________________________________***<br /> (princ "\n【梁载计算】加载成功!\n")<br /> (princ "=============================================*\n")<br /> (princ "      修改记录                               *\n")<br /> (princ "日期：sheoh 于 2014-04-24                    *\n")<br /> (princ "=============================================*\n")<br /> (princ "欢迎使用【梁载计算】程序,程序命令为:LZJS")<br /> (prin1)<br /> ;;;___________________________________________________________________________________________***

htxhtx

我用c# 也遇到这个问题，好奇怪