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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：执行后不关闭捕获设置
返回列表 发新帖
查看: 721|回复: 8

[求助] [求助]：执行后不关闭捕获设置

[复制链接]
szx025
发表于 2008-2-18 07:59:57 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
(defun *error*(st)
  (if (and (/= st "Function cancelled")
           (/= st "quit / exit abort")
      )
      (princ (strcat "错误: " st))
  )
  (setq *error* old_err)
  (princ)
)

(defun dxf (code en)
  (cdr (assoc code en))
)

(defun tan (ang)
  (/ (sin ang) (cos ang))
)

;;;==============================================
;;;               main   programm
;;;==============================================

(defun C:ss(/ th ths ss bp sp ep pt1 pt2 pt3 pt11 n tmp bbp ssp
              ang1 ang2 ang3 ang4 dis1 dis3)
  (setq old_err *error*)
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (command "layer" "m" "ss" "c" "c" "ss" "")
  (setvar "osmode" 32)

  (if (= ths nil) (setq ths 800.0))
  (setq th (getreal (strcat "\n散水宽度<" (rtos ths 2 0) ">:")))
    (if (= th nil) (setq th ths))
    (setq ths th)

  (setq bp (getpoint "\n第一点: "))
  (setq bbp bp)                                   ;bbp记录下第一点
  (if (= nil bp) (quit))
  (setq sp (getpoint bp "\n下一点(注意:按顺时针): "))
  (setq ssp sp)                                   ;ssp记录下第二点
  (setvar "osmode" 0)
  (if (= nil sp) (quit))
  (setq n 0 tmp 0)         ;n=0为第一条线  ;tmp=0

  (while T
    (setq ang1 (angle bp sp))
    (setq dis1 (distance bp sp))  
    (setq pt1 (polar bp (+ ang1 (* pi 0.5)) ths))
    (setq pt2 (polar pt1 ang1 dis1))
    (if (= 0 n)
      (command "line" pt1 pt2 "")
      (command "line" pt11 pt2 "")       ;临时线
    )
    (setq ss (ssadd))
    (setq ss (ssget "L"))
    (if (= 1 tmp) (command "erase" ss ""))
    (if (= nil ep)
      (progn
        (if (= 1 tmp)
          (progn
            (command "line" pt11 bbp "")
            (redraw)
            (quit)
          )
          (progn
            (setvar "osmode" 32)
            (initget "C")
            (setq ep (getpoint sp "\nC闭合/下一点: "))
            (setvar "osmode" 0)
          )
        )
        (if (= nil ep) (quit))
        (if (eq ep "C") (setq ep bbp))

        (setq ang2 (angle sp ep))
        (setq ang3 (- pi ang1))
        (setq ang4 (- (* pi 2) ang2))
        (setq ang3 (- (/ pi 2) (/ (- ang3 ang4) 2)))
        (setq dis3 (* ths (tan ang3)))

        (setq pt1 (polar bp (+ ang1 (* pi 0.5)) ths))
        (setq pt2 (polar pt1 ang1 (+ dis1 dis3)))
        (command "erase" ss "")
        (if (= 0 n)
          (progn
            (command "line" pt1 pt2 "")
            (setq sss (ssadd))
            (setq sss (ssget "L"))
          )
          (command "line" pt11 pt2 "")
        )
        (if (/= 0 n) (command "line" pt11 bp ""))
      )
      (progn
        (command "erase" sss "")

        (setq ang2 (angle sp ep))
        (setq ang3 (- pi ang1))
        (setq ang4 (- (* pi 2) ang2))
        (setq ang3 (- (/ pi 2) (/ (- ang3 ang4) 2)))
        (setq dis3 (* ths (tan ang3)))

        (setq pt1 (polar bp (+ ang1 (* pi 0.5)) ths))
        (setq pt2 (polar pt1 ang1 (+ dis1 dis3)))
        (command "erase" ss "")
        (command "line" pt11 pt2 "")
        (setq ss (ssadd))
        (setq ss (ssget "L"))
        (command "line" pt2 pte1 "")
        (command "line" pt11 bp "")
        (setq tmp 1)
      )
    )
    (if (= 0 n)
      (setq pte1 pt2)
    )
    (setq pt11 pt2)
    (setq bp sp sp ep n 1)
    (if (equal bbp ep)
      (setq ep ssp)
      (setq ep nil)
    )
    (if (eq ep "C") (quit))
  )
  (princ)  
)

这是一个建筑图中画散水线的程序，程序执行后它会关闭捕获（F3),如何让程序执行后不关闭捕获设置
setq, command, ang1

相关帖子

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

使用道具 举报

Wildcat
发表于 2008-2-18 11:06:43 | 显示全部楼层

Re: [求助]：执行后不关闭捕获设置

最初由 szx025 发布
[B](defun *error*(st)
  (if (and (/= st "Function cancelled")
           (/= st "quit / exit abort")
      )
      (princ (strcat "错误: " st))
  )
  (setq *error* old_err)
  (princ)
)

(defun ... [/B]


  3.   [FONT=courier new]
  4. 试试这样行吗?

  6. (defun *error* (st)
  7.   (if (and (/= st "Function cancelled")
  8.            (/= st "quit / exit abort")
  9.       )
  10.     (princ (strcat "错误: " st))
  11.   )
  12.   (setq *error* old_err)
  13.   (princ)
  14. )

  16. (defun dxf (code en)
  17.   (cdr (assoc code en))
  18. )

  20. (defun tan (ang)
  21.   (/ (sin ang) (cos ang))
  22. )

  24. ;;;==============================================
  25. ;;; main programm
  26. ;;;==============================================

  28. (defun C:ss (/           th         ths   ss    bp           sp         ep    pt1   pt2
  29.              pt3   pt11         n     tmp   bbp   ssp         ang1  ang2  ang3
  30.              ang4  dis1         dis3
  31.             )
  32.   (setq old_err *error*)
  33.   (setvar "CMDECHO" 0)
  34.   (setvar "BLIPMODE" 0)
  35.   (setq osmode_s (getvar "osmode"));;<------------------
  36.   (command "layer" "m" "ss" "c" "c" "ss" "")
  37.   (setvar "osmode" 32)

  39.   (if (= ths nil)
  40.     (setq ths 800.0)
  41.   )
  42.   (setq th (getreal (strcat "\n散水宽度<" (rtos ths 2 0) ">:")))
  43.   (if (= th nil)
  44.     (setq th ths)
  45.   )
  46.   (setq ths th)

  48.   (setq bp (getpoint "\n第一点: "))
  49.   (setq bbp bp)                                ;bbp记录下第一点
  50.   (if (= nil bp)
  51.     (progn
  52.       (setvar "osmode" osmode_s);;<------------------
  53.     (quit)
  54.       )
  55.   )
  56.   (setq sp (getpoint bp "\n下一点(注意:按顺时针): "))
  57.   (setq ssp sp)                                ;ssp记录下第二点
  58.   (setvar "osmode" 0)
  59.   (if (= nil sp)
  60.     (progn
  61.       (setvar "osmode" osmode_s);;<------------------
  62.     (quit)
  63.       )
  64.   )
  65.   (setq        n 0
  66.         tmp 0
  67.   )                                        ;n=0为第一条线 ;tmp=0

  69.   (while T
  70.     (setq ang1 (angle bp sp))
  71.     (setq dis1 (distance bp sp))
  72.     (setq pt1 (polar bp (+ ang1 (* pi 0.5)) ths))
  73.     (setq pt2 (polar pt1 ang1 dis1))
  74.     (if        (= 0 n)
  75.       (command "line" pt1 pt2 "")
  76.       (command "line" pt11 pt2 "")        ;临时线
  77.     )
  78.     (setq ss (ssadd))
  79.     (setq ss (ssget "L"))
  80.     (if        (= 1 tmp)
  81.       (command "erase" ss "")
  82.     )
  83.     (if        (= nil ep)
  84.       (progn
  85.         (if (= 1 tmp)
  86.           (progn
  87.             (command "line" pt11 bbp "")
  88.             (redraw)
  89.             (setvar "osmode" osmode_s);;<------------------
  90.             (quit)
  91.           )
  92.           (progn
  93.             (setvar "osmode" 32)
  94.             (initget "C")
  95.             (setq ep (getpoint sp "\nC闭合/下一点: "))
  96.             (setvar "osmode" 0)
  97.           )
  98.         )
  99.         (if (= nil ep)
  100.           (progn
  101.            (setvar "osmode" osmode_s);;<------------------
  102.           (quit)
  103.           )
  104.         )
  105.         (if (eq ep "C")
  106.           (setq ep bbp)
  107.         )

  109.         (setq ang2 (angle sp ep))
  110.         (setq ang3 (- pi ang1))
  111.         (setq ang4 (- (* pi 2) ang2))
  112.         (setq ang3 (- (/ pi 2) (/ (- ang3 ang4) 2)))
  113.         (setq dis3 (* ths (tan ang3)))

  115.         (setq pt1 (polar bp (+ ang1 (* pi 0.5)) ths))
  116.         (setq pt2 (polar pt1 ang1 (+ dis1 dis3)))
  117.         (command "erase" ss "")
  118.         (if (= 0 n)
  119.           (progn
  120.             (command "line" pt1 pt2 "")
  121.             (setq sss (ssadd))
  122.             (setq sss (ssget "L"))
  123.           )
  124.           (command "line" pt11 pt2 "")
  125.         )
  126.         (if (/= 0 n)
  127.           (command "line" pt11 bp "")
  128.         )
  129.       )
  130.       (progn
  131.         (command "erase" sss "")

  133.         (setq ang2 (angle sp ep))
  134.         (setq ang3 (- pi ang1))
  135.         (setq ang4 (- (* pi 2) ang2))
  136.         (setq ang3 (- (/ pi 2) (/ (- ang3 ang4) 2)))
  137.         (setq dis3 (* ths (tan ang3)))

  139.         (setq pt1 (polar bp (+ ang1 (* pi 0.5)) ths))
  140.         (setq pt2 (polar pt1 ang1 (+ dis1 dis3)))
  141.         (command "erase" ss "")
  142.         (command "line" pt11 pt2 "")
  143.         (setq ss (ssadd))
  144.         (setq ss (ssget "L"))
  145.         (command "line" pt2 pte1 "")
  146.         (command "line" pt11 bp "")

  148.         (setq tmp 1)
  149.       )
  150.     )
  151.     (if        (= 0 n)
  152.       (setq pte1 pt2)
  153.     )
  154.     (setq pt11 pt2)
  155.     (setq bp sp
  156.           sp ep
  157.           n  1
  158.     )
  159.     (if        (equal bbp ep)
  160.       (setq ep ssp)
  161.       (setq ep nil)
  162.     )
  163.     (if        (eq ep "C")
  164.       (progn
  165.       (setvar "osmode" osmode_s);;<------------------
  166.       (quit)
  167.       )
  168.     )
  169.   )
  170.   (setvar "osmode" osmode_s);;<------------------
  171.   (princ)
  172. )

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

使用道具 举报

gysjy
发表于 2008-2-18 12:28:17 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

Re: [求助]：执行后不关闭捕获设置

最初由 szx025 发布
[B](defun *error*(st)
  (if (and (/= st "Function cancelled")
           (/= st "quit / exit abort")
      )
      (princ (strcat "错误: " st))
  )
  (setq *error* old_err)
  (princ)
)

(defun ... [/B]


在程序开始处(setvar "BLIPMODE" 0)后增加：
(setq osn (getvar "osmode"))
在程序结尾处(princ)前增加：
(setvar  "osmode" osn)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

gysjy
发表于 2008-2-18 12:34:25 | 显示全部楼层

Re: [求助]：执行后不关闭捕获设置

最初由 szx025 发布
[B](defun *error*(st)
  (if (and (/= st "Function cancelled")
           (/= st "quit / exit abort")
      )
      (princ (strcat "错误: " st))
  )
  (setq *error* old_err)
  (princ)
)

(defun ... [/B]


在程序开始处(setvar "BLIPMODE" 0)后增加：
(setq osn (getvar "osmode"))
在程序结尾处(princ)前增加：
(setvar  "osmode" osn)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

szx025
 楼主| 发表于 2008-2-18 13:20:47 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
谢谢2楼的朋友，
gysjy朋友的办法好像不行
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zml84

已领礼包: 2个

财富等级: 恭喜发财
发表于 2008-2-18 17:29:23 | 显示全部楼层
4楼方法是可行的。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

leeyuan
发表于 2008-2-18 19:11:20 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
可能楼主不是很熟悉lisp
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

szx025
 楼主| 发表于 2008-2-18 19:33:10 | 显示全部楼层
我试了4楼的办法，确实不行
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

gysjy
发表于 2008-2-19 20:48:52 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 szx025 发布
[B]我试了4楼的办法，确实不行 [/B]

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-16 21:53 , Processed in 0.198111 second(s), 45 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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