明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1547|回复: 1

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

[复制链接]
发表于 2015-4-1 17:25 | 显示全部楼层 |阅读模式
本帖最后由 sheoh 于 2015-4-1 17:27 编辑

如题,ODCL非模态对话框运行时CAD总是崩溃,改为模态对话框就没问题了,不知道为什么。初次接触非模态对话框,不太了解,请多指教。
  1. (DEFUN C:LZJS1 (/ old_cmd)
  2.   (setq pt1 nil pt2 nil pt3 nil Di nil Ang nil LXHZ nil)
  3.   (setq old_cmd (getvar "cmdecho"))
  4.   (setvar "cmdecho" 0)      ;关闭命令回显
  5.   (LZJS_STEP0)
  6.   (setvar "cmdecho" old_cmd)
  7. )
  8. (defun LZJS_STEP0 (/)
  9.   (if (= (tblobjname "style" "LHZ") nil) ;检查文字样式是否存在
  10.     (command "-style" "LHZ" "txt.shx" "300" "1" "0" "N" "N" "N")
  11.   )
  12.   (if (and (setq pt1 (getpoint "\n选择第一点: "))
  13.      (setq pt2 (getpoint pt1 "\n选择第二点: "))
  14.       )
  15.     (progn

  16.       (setq Di (distance pt1 pt2))
  17.       (setq Ang (angle pt1 pt2))
  18.       (LZJS_STEP0_0)
  19.     )
  20.   )
  21. )
  22. (defun LZJS_STEP0_0 (/ )
  23.   (command "opendcl")
  24.   (dcl_Project_Load "LZJS" T)
  25.   (dcl_Form_Show LZJS_Form1)

  26. )
  27.           ;初始化对话框Form1
  28. (defun c:LZJS/Form1#OnInitialize (/)  
  29.   (dcl_Control_SetText LZJS_Form1_TextBox1 (rtos Di 2 0))
  30.   ;|(dcl_Control_SetText LZJS_Form1_TextBox2 (rtos WallH 2 0))
  31.   (dcl_Control_SetText LZJS_Form1_TextBox3 (rtos WallF 2 2))
  32.   (dcl_Control_SetText LZJS_Form1_TextBox4 (rtos DW1W 2 0))
  33.   (dcl_Control_SetText LZJS_Form1_TextBox5 (rtos DW1H 2 0))
  34.   (dcl_Control_SetText LZJS_Form1_TextBox6 (rtos DW2W 2 0))
  35.   (dcl_Control_SetText LZJS_Form1_TextBox7 (rtos DW2H 2 0))
  36.   (dcl_Control_SetText LZJS_Form1_TextBox8 (rtos DW3W 2 0))
  37.   (dcl_Control_SetText LZJS_Form1_TextBox9 (rtos DW3H 2 0))
  38.   (dcl_Control_SetText LZJS_Form1_TextBox10 (rtos DWF 2 2))
  39.   (dcl_Control_SetText LZJS_Form1_TextBox11 (rtos TextH 2 0))|;
  40. )
  41.           ;点击确定按钮后执行命令
  42. (defun c:LZJS/Form1/TextButton1#OnClicked (/)
  43.   (setq WallH (atof (dcl_Control_GetText LZJS_Form1_TextBox2)))
  44.   (setq WallF (atof (dcl_Control_GetText LZJS_Form1_TextBox3)))
  45.   (setq DW1W (atof (dcl_Control_GetText LZJS_Form1_TextBox4)))
  46.   (setq DW1H (atof (dcl_Control_GetText LZJS_Form1_TextBox5)))
  47.   (setq DW2W (atof (dcl_Control_GetText LZJS_Form1_TextBox6)))
  48.   (setq DW2H (atof (dcl_Control_GetText LZJS_Form1_TextBox7)))
  49.   (setq DW3W (atof (dcl_Control_GetText LZJS_Form1_TextBox8)))
  50.   (setq DW3H (atof (dcl_Control_GetText LZJS_Form1_TextBox9)))
  51.   (setq DWF (atof (dcl_Control_GetText LZJS_Form1_TextBox10)))
  52.   (setq TextH (atof (dcl_Control_GetText LZJS_Form1_TextBox11)))
  53.   (dcl_Form_Close LZJS_Form1 1)

  54.   (setq pt3 (polar pt1 Ang (* 0.5 Di)))
  55.   (setq DW1A (* DW1W DW1H))
  56.   (setq DW2A (* DW2W DW2H))
  57.   (setq DW3A (* DW3W DW3H))
  58.   (setq DWarea (+ DW1A DW2A DW3A))
  59.   (setq  LXHZ (/  (+ (* WallF (- (* Di WallH) DWarea)) (* DWF DWarea))
  60.     (* 1000 Di)
  61.        )
  62.   )
  63.   (if (= (tblobjname "layer" "梁荷载") nil) ;检查图层是否存在
  64.     (progn
  65.       (entmake (list      ;创建图层
  66.      '(0 . "LAYER")
  67.      '(100 . "AcDbSymbolTableRecord")
  68.      '(100 . "AcDbLayerTableRecord")
  69.      '(6 . "CONTINUOUS")
  70.      '(62 . 1)
  71.      '(70 . 0)
  72.      (cons 2 "梁荷载")
  73.          )
  74.       )
  75.     )
  76.   )
  77.   (entmake (list '(0 . "TEXT")
  78.      (cons 1 (rtos LXHZ 2 1))
  79.      (cons 8 "梁荷载")
  80.      (cons 7 "LHZ")
  81.      (cons 10 pt3)
  82.      (cons 40 TextH)
  83.      (cons 11 pt3)
  84.      (cons 50 Ang)
  85.      (cons 72 1)
  86.      (cons 73 1)
  87.      )
  88.   )
  89.   (entmake
  90.     (list
  91.       '(0 . "LWPOLYLINE")   
  92.       '(100 . "AcDbEntity")
  93.       '(100 . "AcDbPolyline")
  94.       '(90 . 2)   
  95.       '(70 . 0)
  96.       (cons 8 "梁荷载")
  97.       (cons 43 100)
  98.       (cons 10 (list (car pt1) (cadr pt1)))
  99.       (cons 10 (list (car pt2) (cadr pt2)))
  100.       (cons 210 '(0 0 1))
  101.     )
  102.   )
  103. )
  104.           ;点击取消按钮后退出程序
  105. (defun c:LZJS/Form1/TextButton2#OnClicked (/)
  106.   (dcl_Form_Close LZJS_Form1 1)
  107.   (setvar "cmdecho" old_cmd)
  108.   (gc)
  109.   (exit)
  110. )




  111. ;;;___________________________________________________________________________________________***
  112. (princ "\n【梁载计算】加载成功!\n")
  113. (princ "=============================================*\n")
  114. (princ "      修改记录                               *\n")
  115. (princ "日期:sheoh 于 2014-04-24                    *\n")
  116. (princ "=============================================*\n")
  117. (princ "欢迎使用【梁载计算】程序,程序命令为:LZJS")
  118. (prin1)
  119. ;;;___________________________________________________________________________________________***

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2022-6-4 18:36 | 显示全部楼层
我用c# 也遇到这个问题,好奇怪
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-28 21:08 , Processed in 0.272351 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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