设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 程序（函数）库 › LISP/VLISP程序库 › [LISP程序]：不同格式的明细栏生成程序。 ...
返回列表 发新帖
查看: 558|回复: 1

[LISP程序]：不同格式的明细栏生成程序。

[复制链接]
正航
发表于 2003-5-7 16:00:51 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
;;明细栏生成程序，提供两种不同形式的明细栏生成，只需要对相对应的图块作简单改动，就可以用于生成自己需要的明细栏，当然也可以用与类似的场合。
请把附件中的图块解压缩到LISP程序同一目录下。

本人原创啊^_^


  4. (defun c:sengt02 (/ dcl_id lt lay lno sno eno bt s nt rp) ;主程序
  5.   (setvar "cmdecho" 0)
  6.   (setvar "ATTDIA" 0)
  7.   (setVAR "ATTREQ" 1)
  8.   (setq rp (getvar "luprec"))
  9.   (setq lay (getvar "clayer"))
  10.   (setvar "clayer" "01")
  11.   (setvar "luprec" 0)
  12.   (setq dcl_id (load_dialog  "sengt02.DCL"))
  13.   (if (not (new_dialog "SENGT02A" dcl_id))
  14.     (exit)
  15.   )
  16.   (if (= lt nil)
  17.     (setq lt 1)
  18.   )
  19.   (if (= lno nil)
  20.     (setq lno 10)
  21.   )
  22.   (set_tile "LNO" (rtos lno))
  23.   (if (= sno nil)
  24.     (setq sno 1)
  25.   )
  26.   (setq nt 1)
  27.   (set_tile "SN" (rtos sno))
  28.   (setq eno (- (+ sno lno) 1))
  29.   (set_tile "EN" (rtos eno))
  30.   (setq bt 1)
  31.   (set_tile "BT" (rtos bt))
  32.   (action_tile "LU" "(setq lt 1)")
  33.   (action_tile "LG" "(setq lt 2)")
  34.   (action_tile "LNO" "(sengt0211)")
  35.   (action_tile "SN" "(sengt0211)")
  36.   (action_tile "A" "(progn (setq nt 1)(sengt0210))")
  37.   (action_tile "L" "(progn (setq nt 0)(sengt0210))")
  38.   (action_tile "BT" "(setq bt $value)")
  39.   (action_tile "accept" "(done_dialog 1)")
  40.   (action_tile "cancel" "(done_dialog 0)")
  41.   (setq next (start_dialog))
  42.   (if (/= next 0)
  43.     (sengt021)
  44.     (princ "\n取消生成。")
  45.   )
  46.   (unload_dialog dcl_id)
  47.   (setvar "clayer" lay)
  48.   (setvar "luprec" rp)
  49.   (princ)
  50. )

  52. (defun sengt021        ()
  53.   (setq s 1)
  54.   (while s
  55.     (setq pA (getpoint "\n请选择明细栏生成的基准点<右下角点>："))
  56.     (if        (/= pa nil)
  57.       (setq s nil)
  58.     )
  59.   )
  60.   (if (= bt 1)
  61.     (progn
  62.       (if (= lt 1)
  63.         (progn
  64.           (command ".insert"
  65.                      "SYSMXLAA.DWG"
  66.                    pa
  67.                    ""
  68.                    ""
  69.                    ""
  70.           )
  71.           (setq pa (list (car pa) (+ (cadr pa) 12)))
  72.         )
  73.         (progn
  74.           (command ".insert"
  75.                    "SYSMXLBB.DWG"
  76.                    pa
  77.                    ""
  78.                    ""
  79.                    ""
  80.           )

  82.           (setq pa (list (car pa) (+ (cadr pa) 10)))
  83.         )
  84.       )
  85.     )
  86.   )
  87.   (setq no sno)
  88.   (setq s 1)
  89.   (while s
  90.     (if        (= lt 1)
  91.       (command "insert"
  92.                "SYSMXLA.DWG"
  93.                Pa
  94.                ""
  95.                ""
  96.                ""
  97.                (rtos no)
  98.                ""
  99.                ""
  100.                ""
  101.                ""
  102.                ""
  103.                ""
  104.                "" ""
  105.       )
  106.       (command "insert"
  107.                "SYSMXLB.DWG"
  108.                Pa
  109.                ""
  110.                ""
  111.                ""
  112.                (rtos no)
  113.                ""
  114.                ""
  115.                ""
  116.                ""
  117.                ""
  118.                ""
  119.       )
  120.     )
  121.     (setq lno (- lno 1))
  122.     (if        (<= lno 0)
  123.       (setq s nil)
  124.       (progn
  125.         (setq no (+ no 1))
  126.         (setq pa (list (car pa) (+ (cadr pa) 8)))
  127.       )
  128.     )
  129.   )
  130. )



  134. (defun sengt0210 ()
  135.   ;;(setq lno (distof (get_tile "LNO")))
  136.   (if (= nt 1)
  137.     (setq lno (+ lno 1))
  138.     (setq lno (- lno 1))
  139.   )
  140.   (if (< lno 1)
  141.     (setq lno 1)
  142.   )
  143.   (setq eno (- (+ sno lno) 1))
  144.   (set_tile "LNO" (rtos lno))
  145.   (set_tile "EN" (rtos eno))
  146. )

  148. (defun sengt0211 ()
  149.   (setq lno (distof (get_tile "LNO")))
  150.   (setq sno (distof (get_tile "SN")))
  151.   (setq eno (- (+ sno lno) 1))
  152.   (set_tile "LNO" (rtos lno))
  153.   (set_tile "EN" (rtos eno))
  154. )

  156. ;;LISP程序结束

  158. ;;下面是对应的DCL文件，请注意应该放在同一目录，否则请修改程序制定目录.

  160. dcl_settings : default_dcl_settings { audit_level = 3; }
  161. SENGT02A : dialog {
  162.    initial_focus = "LU" ;
  163.    label = "生成明细栏" ;
  164.    : row {
  165.       children_fixed_width = true ;
  166.       fixed_width = true ;
  167.       width = 46 ;
  168.       height = 3 ;
  169.       : boxed_radio_column {
  170.          children_fixed_height = true ;
  171.          key = "LT" ;
  172.          label = "明细栏类型：" ;
  173.          fixed_width = true ;
  174.          width = 21 ;
  175.          height = 3 ;
  176.          : radio_button {
  177.             key = "LU" ;
  178.             label = "A. 设备型" ;
  179.             mnemonic = "A" ;
  180.             fixed_width = true ;
  181.             width = 5 ;
  182.             height = 1 ;
  183.          }
  184.          : radio_button {
  185.             key = "LG" ;
  186.             label = "B. 工艺型" ;
  187.             mnemonic = "B" ;
  188.             fixed_width = true ;
  189.             width = 5 ;
  190.             height = 1 ;
  191.          }
  192.       }
  193.       : boxed_column {
  194.          fixed_width = true ;
  195.          width = 19 ;
  196.          height = 3 ;
  197.          : edit_box {
  198.             edit_width = 3 ;
  199.             key = "LNO" ;
  200.             label = "插入栏数：" ;
  201.             width = 4 ;
  202.             height = 1 ;
  203.          }
  204.          : row {
  205.             width = 19 ;
  206.             height = 1 ;
  207.             : button {
  208.                key = "A" ;
  209.                label = "+" ;
  210.                width = 2 ;
  211.                height = 1 ;
  212.             }
  213.             : button {
  214.                key = "L" ;
  215.                label = "—" ;
  216.                fixed_width = true ;
  217.                width = 3 ;
  218.                height = 1 ;
  219.             }
  220.          }
  221.       }
  222.    }
  223.    : row {
  224.       children_fixed_height = true ;
  225.       children_fixed_width = true ;
  226.       fixed_width = true ;
  227.       width = 45 ;
  228.       height = 1 ;
  229.       : boxed_row {
  230.          label = "标题栏序号：" ;
  231.          fixed_width = true ;
  232.          width = 25 ;
  233.          height = 1 ;
  234.          : edit_box {
  235.             edit_limit = 3 ;
  236.             edit_width = 2 ;
  237.             key = "SN" ;
  238.             label = "始:" ;
  239.             fixed_width = true ;
  240.             width = 2 ;
  241.             height = 1 ;
  242.          }
  243.          : edit_box {
  244.             edit_limit = 4 ;
  245.             edit_width = 2 ;
  246.             key = "EN" ;
  247.             label = "至：" ;
  248.             fixed_width = true ;
  249.             width = 2 ;
  250.             height = 1 ;
  251.          }
  252.       }
  253.       : toggle {
  254.          key = "BT" ;
  255.          label = "带明细栏头" ;
  256.          fixed_width = true ;
  257.          width = 3 ;
  258.          height = 1 ;
  259.       }
  260.    }
  261.    ok_cancel ;
  262. }

  264. ;;DCL文件结束，请把此代码保存为sengt02.DCL

width, setq, lno

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

梦断江南
发表于 2003-5-7 22:13:56 | 显示全部楼层
最好有个贴图或教学,直观些
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-12-18 22:55 , Processed in 0.381605 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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