设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 从来没写过对话框，今天练习一下
返回列表 发新帖
查看: 902|回复: 1

[源码] 从来没写过对话框，今天练习一下

[复制链接]
菜卷鱼
发表于 2015-11-17 14:08 | 显示全部楼层 |阅读模式
  1. (defun c:ltcal  (/ a b m n h)
  2.   (setq  dclname
  3.    (cond
  4.      (
  5.       (setq tempname (vl-filename-mktemp "ltcal-dcl-tmp.dcl")
  6.       filen     (open tempname "w"))
  7.       (foreach stream
  8.          '(
  9.            "\n"
  10.            "ltcal:dialog {\n"
  11.            "    label = \"\\n菱台体积计算\" ;\n"

  13.            "    :row {\n"

  15.            "        :boxed_column  {\n"
  16.            "    :column {\n"
  17.            "        :edit_box {\n"
  18.            "            label = \"上底面边长a \" ;\n"
  19.            "            key = \"sda_name\" ;\n"
  20.            "            width = 22 ;\n"
  21.            "        }\n"
  22.            "        :edit_box {\n"
  23.            "            label = \"上底面边长b \" ;\n"
  24.            "            key = \"sdb_name\" ;\n"
  25.            "            width = 22 ;\n"
  26.            "        }\n"
  27.            "        :edit_box {\n"
  28.            "            label = \"下底面边长m\" ;\n"
  29.            "            key = \"xda_name\" ;\n"
  30.            "            width = 22 ;\n"
  31.            "        }\n"
  32.            "        :edit_box {\n"
  33.            "            label = \"下底面边长n \" ;\n"
  34.            "            key = \"xdb_name\" ;\n"
  35.            "            width = 22 ;\n"
  36.            "        }\n"
  37.            "        :edit_box {\n"
  38.            "            label = \"两底面高度H\" ;\n"
  39.            "            key = \"GD_name\" ;\n"
  40.            "            width = 22 ;\n"
  41.            "        }\n"
  42.            "        }\n"
  43.            "        }\n"


  46.            "        :boxed_column  {\n"
  47.            "        :text {\n"
  48.            "            label = \"体积V=H/6\" ;\n"
  49.            "        }\n"

  51.            "        :text {\n"
  52.            "            label = \"[a*b+m*n+(a+m)*(b+n)]\" ;\n"
  53.            "        }\n"

  55.            "        :row {\n"
  56.            "        :button {\n"
  57.            "            key = \"js_ok\" ;\n"
  58.            "            label = \"计算\" ;\n"
  59.            "            width = 5 ;\n"
  60.            "        }\n"

  62.            "        :button {\n"
  63.            "            key = \"FZ_bt\" ;\n"
  64.            "            label = \"复制结果\" ;\n"
  65.            "            width = 15 ;\n"
  66.            "        }\n"
  67.            "        }\n"

  69.            "        :edit_box {\n"
  70.            "            label = \"计算结果\" ;\n"
  71.            "            key = \"JG_name\" ;\n"
  72.            "            width = 27 ;\n"
  73.            "        }\n"

  75.            "        :button {\n"
  76.            "            is_cancel = true ;\n"
  77.            "            key = \"btn_cancle\" ;\n"
  78.            "            label = \"退出\" ;\n"
  79.            "        }\n"

  81.            "        }\n"
  82.            "        }\n"

  84.            "        :boxed_column  {\n"
  85.            "        :text {\n"
  86.            "            label = \"     ____a_____\" ;\n"
  87.            "            alignment = centered ;\n"
  88.            "        }\n"
  89.            "        :text {\n"
  90.            "            label = \"   ╱  /       b / ╲\" ;\n"
  91.            "            alignment = centered ;\n"
  92.            "        }\n"
  93.            "        :text {\n"
  94.            "            label = \"   ╱    /_________/     ╲\" ;\n"
  95.            "            alignment = centered ;\n"
  96.            "        }\n"
  97.            "        :text {\n"
  98.            "            label = \"   /    ╱     H      \\\\      /\" ;\n"
  99.            "            alignment = centered ;\n"
  100.            "        }\n"
  101.            "        :text {\n"
  102.            "            label = \"    /  ╱                \\\\    / n  \" ;\n"
  103.            "            alignment = centered ;\n"
  104.            "        }\n"
  105.            "        :text {\n"
  106.            "            label = \"/╱           m        \\\\  /  \" ;\n"
  107.            "            alignment = centered ;\n"
  108.            "        }\n"
  109.            "        :text {\n"
  110.            "            label = \"￣￣￣￣￣￣￣￣￣￣￣ \"   ;\n"
  111.            "            alignment = centered ;\n"
  112.            "        }\n"

  114.            "        :text {\n"
  115.            "            label = \"              注：a与m、b与n需分别平行\" ;\n"
  116.            "        }\n"
  117.            "        }\n"

  119.            "}\n"
  120.            )
  121.         (princ stream filen)
  122.         )
  123.       (close filen)
  124.       tempname
  125.       )
  126.      )
  127.   )
  128.   (SETQ DCL_ID (LOAD_DIALOG dclname))
  129.   (NEW_DIALOG "ltcal" DCL_ID)

  131.   (mode_tile "JG_name" 1)

  133.   (action_TILE
  134.     "js_ok"
  135.     "(cal_res)(SET_TILE \"JG_name\" (rtos (* (/ h 6) (+ (* a b)(* m n) (* (+ a m)(+ b n)))) 2 4) )
  136.        (mode_tile \"JG_name\" 2) ")

  138.   (action_tile
  139.     "FZ_bt"
  140.     "(SET-CLIP-STRING (get_TILE \"JG_name\" ))")

  142.   (START_DIALOG)
  143.   (UNLOAD_DIALOG DCL_ID)
  144.   (vl-file-delete dclname)
  145.   (prin1)
  146.   )


  149. (defun cal_res  ()
  150.   (SETQ a (atof (GET_TILE "sda_name")))
  151.   (SETQ b (atof (GET_TILE "sdb_name")))
  152.   (SETQ m (atof (GET_TILE "xda_name")))
  153.   (SETQ n (atof (GET_TILE "xdb_name")))
  154.   (SETQ h (atof (GET_TILE "GD_name")))
  155.   )

  157. (defun SET-CLIP-STRING  (STR / HTML RESULT)
  158.   (and (= (type STR) 'STR)
  159.        (setq HTML (vlax-create-object "htmlfile"))
  160.        (setq RESULT (vlax-invoke
  161.           (vlax-get  (vlax-get HTML 'PARENTWINDOW)
  162.         'CLIPBOARDDATA
  163.         )
  164.           'SETDATA
  165.           "Text"
  166.           STR
  167.           )
  168.        )
  169.        (vlax-release-object HTML)
  170.        )
  171.   )

  173. (prin1)

对话框
"觉得好，就打赏"
打赏
还没有人打赏，支持一下

相关帖子
回复

使用道具 举报

1905975672
发表于 2015-11-17 15:05 | 显示全部楼层
http://bbs.mjtd.com/thread-170154-1-1.html
CAD画图的方式编写DCL
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-4-27 05:56 , Processed in 0.301617 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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