ODCL非模态对话框运行时CAD总是崩溃
本帖最后由 sheoh 于 2015-4-1 17:27 编辑如题，ODCL非模态对话框运行时CAD总是崩溃，改为模态对话框就没问题了，不知道为什么。初次接触非模态对话框，不太了解，请多指教。(DEFUN C:LZJS1 (/ old_cmd)
(setq pt1 nil pt2 nil pt3 nil Di nil Ang nil LXHZ nil)
(setq old_cmd (getvar "cmdecho"))
(setvar "cmdecho" 0) ;关闭命令回显
(LZJS_STEP0)
(setvar "cmdecho" old_cmd)
)
(defun LZJS_STEP0 (/)
(if (= (tblobjname "style" "LHZ") nil) ;检查文字样式是否存在
(command "-style" "LHZ" "txt.shx" "300" "1" "0" "N" "N" "N")
)
(if (and (setq pt1 (getpoint "\n选择第一点: "))
(setq pt2 (getpoint pt1 "\n选择第二点: "))
)
(progn
(setq Di (distance pt1 pt2))
(setq Ang (angle pt1 pt2))
(LZJS_STEP0_0)
)
)
)
(defun LZJS_STEP0_0 (/ )
(command "opendcl")
(dcl_Project_Load "LZJS" T)
(dcl_Form_Show LZJS_Form1)
)
;初始化对话框Form1
(defun c:LZJS/Form1#OnInitialize (/)
(dcl_Control_SetText LZJS_Form1_TextBox1 (rtos Di 2 0))
;|(dcl_Control_SetText LZJS_Form1_TextBox2 (rtos WallH 2 0))
(dcl_Control_SetText LZJS_Form1_TextBox3 (rtos WallF 2 2))
(dcl_Control_SetText LZJS_Form1_TextBox4 (rtos DW1W 2 0))
(dcl_Control_SetText LZJS_Form1_TextBox5 (rtos DW1H 2 0))
(dcl_Control_SetText LZJS_Form1_TextBox6 (rtos DW2W 2 0))
(dcl_Control_SetText LZJS_Form1_TextBox7 (rtos DW2H 2 0))
(dcl_Control_SetText LZJS_Form1_TextBox8 (rtos DW3W 2 0))
(dcl_Control_SetText LZJS_Form1_TextBox9 (rtos DW3H 2 0))
(dcl_Control_SetText LZJS_Form1_TextBox10 (rtos DWF 2 2))
(dcl_Control_SetText LZJS_Form1_TextBox11 (rtos TextH 2 0))|;
)
;点击确定按钮后执行命令
(defun c:LZJS/Form1/TextButton1#OnClicked (/)
(setq WallH (atof (dcl_Control_GetText LZJS_Form1_TextBox2)))
(setq WallF (atof (dcl_Control_GetText LZJS_Form1_TextBox3)))
(setq DW1W (atof (dcl_Control_GetText LZJS_Form1_TextBox4)))
(setq DW1H (atof (dcl_Control_GetText LZJS_Form1_TextBox5)))
(setq DW2W (atof (dcl_Control_GetText LZJS_Form1_TextBox6)))
(setq DW2H (atof (dcl_Control_GetText LZJS_Form1_TextBox7)))
(setq DW3W (atof (dcl_Control_GetText LZJS_Form1_TextBox8)))
(setq DW3H (atof (dcl_Control_GetText LZJS_Form1_TextBox9)))
(setq DWF (atof (dcl_Control_GetText LZJS_Form1_TextBox10)))
(setq TextH (atof (dcl_Control_GetText LZJS_Form1_TextBox11)))
(dcl_Form_Close LZJS_Form1 1)
(setq pt3 (polar pt1 Ang (* 0.5 Di)))
(setq DW1A (* DW1W DW1H))
(setq DW2A (* DW2W DW2H))
(setq DW3A (* DW3W DW3H))
(setq DWarea (+ DW1A DW2A DW3A))
(setqLXHZ (/(+ (* WallF (- (* Di WallH) DWarea)) (* DWF DWarea))
(* 1000 Di)
)
)
(if (= (tblobjname "layer" "梁荷载") nil) ;检查图层是否存在
(progn
(entmake (list ;创建图层
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS")
'(62 . 1)
'(70 . 0)
(cons 2 "梁荷载")
)
)
)
)
(entmake (list '(0 . "TEXT")
(cons 1 (rtos LXHZ 2 1))
(cons 8 "梁荷载")
(cons 7 "LHZ")
(cons 10 pt3)
(cons 40 TextH)
(cons 11 pt3)
(cons 50 Ang)
(cons 72 1)
(cons 73 1)
)
)
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 2)
'(70 . 0)
(cons 8 "梁荷载")
(cons 43 100)
(cons 10 (list (car pt1) (cadr pt1)))
(cons 10 (list (car pt2) (cadr pt2)))
(cons 210 '(0 0 1))
)
)
)
;点击取消按钮后退出程序
(defun c:LZJS/Form1/TextButton2#OnClicked (/)
(dcl_Form_Close LZJS_Form1 1)
(setvar "cmdecho" old_cmd)
(gc)
(exit)
)
;;;___________________________________________________________________________________________***
(princ "\n【梁载计算】加载成功!\n")
(princ "=============================================*\n")
(princ " 修改记录 *\n")
(princ "日期：sheoh 于 2014-04-24 *\n")
(princ "=============================================*\n")
(princ "欢迎使用【梁载计算】程序,程序命令为:LZJS")
(prin1)
;;;___________________________________________________________________________________________*** 我用c# 也遇到这个问题，好奇怪
页:
[1]