zylaser 发表于 2003-4-11 17:28:00

我写的打缺口程序为什么有时会出错?

本帖最后由 作者 于 2003-4-11 17:28:25 编辑

该程序是用来将线、圆、弧打上缺口,缺口大小与个数由用户输入,但是在使用过程中,当用户输入的个数太多时,经常会发生所生成的缺口不是用户输入的大小,并且位置也不正确,请大家帮我分析一下此程序,谢谢!

(defun c:bk ()
(setvar "cmdecho" 0)
(command "layer" "S" "0" "")
(command "pickbox" 3)
(setq        p (/ pi 2.0)
        g (+ pi p)
)
(if (= qbl nil)
    (setq qbl 6)
    (setq qbl qbl)
)
(setq ai qbl)
(setq aai (rtos ai 2 2))
(setq abi "<")
(setq aci ">")
(setq adi "\n 请输入半断尺寸:")
(setq qbl (getdist (strcat adi abi aai aci)))
(if (= qbl nil)
    (setq qbl ai)
    (setq qbl qbl)
)
(setq aa (ssget))
(setq qi 0)
(setq ab (ssadd))
(repeat (sslength aa)
    (setq aab (ssname aa qi))
    (setq bb (cdr (assoc 0 (entget aab))))


    (cond ((= bb "LINE")
           (setq st (cdr (assoc 11 (entget aab))))
           (setq qed (cdr (assoc 10 (entget aab))))
           (setq ad (distance st qed)
               dd (angle st qed)
               de (angle qed st)
           )
           (command "pickbox" 3)
           (cond ((= qi 0)
                  (setq qcc (getdist "\n 输入半断个数:<1>"))
                  (if (= qcc nil)
                  (setq qcc 1)
                  (setq qcc qcc)
                  )
               )
           )
           (cond ((= qcc 1)
                  (setq aj (/ (- ad qbl) 2.0))
               )
           )
           (cond ((> qcc 1)
                  (setq ej (/(* (/ (- ad (* qbl qcc)) (+ qcc 1)) 2) 3))
                  (setq aj ej)
               )
           )
           (setq xa (polar st dd aj))
           (setq j 1)
           (while (<= j qcc)
             (cond ((>= j 2)
                  (setq
                      aj (/ (- (- ad (* ej 2)) (* qbl qcc)) (- qcc 1))
                  )
                  (setq
                      xa (polar z2 dd aj)
                  )
                   )
             )
             (setq j (+ j 1))
             (setq
             z1 (polar xa dd 0)
             z2 (polar xa dd qbl)
             )
             (command "break" z1 z2)
           )
          )
    )


    (cond ((= bb "CIRCLE")
           (command "pickbox" 1)
           (setq st (cdr (assoc 10 (entget aab))))
           (setq aeed (cdr (assoc 40 (entget aab))))
           (cond ((= qi 0)
                  (setq cb (getint "\n 输入圆上半断个数 :<3>"))
                  (if (= cb nil)
                  (setq cb 3)
                  (setq cb cb)
                  )
               )
           )
           (setq
             xa        (/ (/ qbl aeed) 2.0)
           )
           (setq j 1)
           (setq xb 0)
           (while (<= j cb)
             (cond ((>= j 2)
                  (setq xb (/ (* pi 2.0) cb))
                  (cond ((>= j 3)
                           (setq xb (* xb (- j 1)))
                          )
                  )
                   )
             )
             (setq
             z1 (polar st (- xb xa) aeed)
             z2 (polar st (+ xb xa) aeed)
             )
             (setq j (+ j 1))
             (command "break" z1 z2)
           )
          )
    )


    (cond ((= bb "ARC")
           (command "pickbox" 1)
           (setq st (cdr (assoc 10 (entget aab))))
           (setq ast (cdr (assoc 50 (entget aab))))
           (setq sst (cdr (assoc 51 (entget aab))))
           (setq beed (cdr (assoc 40 (entget aab))))
           (setq
             xa        (/ (/ qbl beed) 2.0)
           )
           (cond ((> ast sst)
                  (cond        ((<= ast p)
                       (setq xb (+ (- p ast) g sst))
                       (setq xxb (/ xb 2.0))
                       (setq xb (+ ast xxb))
                        )
                  )
                  (cond        ((<= ast pi)
                       (setq xb (+ (- pi ast) pi sst))
                       (setq xxb (/ xb 2.0))
                       (setq xb (+ ast xxb))
                        )
                  )
                  (cond        ((<= ast g)
                       (setq xb (+ (- g ast) p sst))
                       (setq xxb (/ xb 2.0))
                       (setq xb (+ ast xxb))
                        )
                  )
                  (cond        ((<= ast (* pi 2.0))
                       (setq xb (+ (- (* pi 2.0) ast) sst))
                       (setq xxb (/ xb 2.0))
                       (setq xb (+ ast xxb))
                        )
                  )
               )
           )
           (cond ((< ast sst)
                  (setq xb (- sst ast))
                  (setq xxb (/ xb 2.0))
                  (setq xb (+ ast xxb))
               )
           )
           (setq
             z1        (polar st (- xb xa) beed)
             z2        (polar st (+ xb xa) beed)
           )
           (command "break" z1 z2)
          )
    )

    (setq qi (+ 1 qi))
)
(command "pickbox" 3)
(princ)
)

meflying 发表于 2003-4-11 17:30:00

程序开始时将系统变量osmode设为0，退出时恢复

zylaser 发表于 2003-4-11 17:37:00

谢谢回答，但问题还没解决，

谢谢回答，但问题还没解决，我的主要问题是在线段上打缺口，有时会将线段打的面目全非，如何解决？请您最好在R14下试用一下。

meflying 发表于 2003-4-11 17:41:00

我是在2000下试的，如果对象捕捉打开，就可能出现你说的情况，关掉它就好了。你可否

我是在2000下试的，如果对象捕捉打开，就可能出现你说的情况，关掉它就好了。你可否再仔细描述下你的情况

zylaser 发表于 2003-4-11 21:23:00

我的这个程序是用在激光切割图形方面的

我的这个程序是用在激光切割图形方面的，这个缺口，专有名词叫“桥位”，就是激光按照图形切割时，桥位的地方就不要切，目的是防止图形中闭合部分掉下去，
举例：我画一个100x100的方框，先炸开它，输入命令bk，默认的半断宽度为6mm,若是直线，默认的半断的个数是1个，若为圆，默认的半断是3,我先选直线，输入2个、3个、4个、等，都能正确的打上缺口，但是若输入的缺口个数过多，则会出现所打的缺口不在我所想要的位置，此时再选其它的线、圆等，都会出现所打的缺口不是6mmm,并且不在要求的位置，但是开新档后，一切又恢复正确，另外我还写了一个程序是用来恢复这个缺口的，我现在检查了bk.lsp的所有参数，但就是找不出为什么会出错

龙龙仔 发表于 2003-4-16 08:10:00

因為(断尺寸*个数) > 總長/圓周,故出錯

cadce 发表于 2014-7-29 22:29:22

有自动打桥吗？就是按线长来自动打？

cadce 发表于 2014-7-29 22:33:06

cadce 发表于 2014-7-29 22:29 static/image/common/back.gif
有自动打桥吗？就是按线长来自动打？

你这个，我简单改了一下。
;;;=================================================================*
;;;=================================================================*
;;;=================================================================*
;;;加桥位
(defun c:ff()
(setq oldecho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)                  ;设置关闭回显
(setq oldmode (getvar "osmode"))      ;保存捕捉
(setvar"osmode" 0)
(command "layer" "S" "" "")
(setq        p (/ pi 2.0)
        g (+ pi p)
)
(if (= qbl nil)
    (setq qbl 4)
    (setq qbl qbl)
)
(setq ai qbl)
(setq aai (rtos ai 2 2))
(setq abi "<")
(setq aci ">")
(setq adi "\n桥位宽度:")
(setq qbl (getdist (strcat adi abi aai aci)))
(if (= qbl nil)
    (setq qbl ai)
    (setq qbl qbl)
)
(setq aa (ssget))
(setq qi 0)
(setq ab (ssadd))
(repeat (sslength aa)
    (setq aab (ssname aa qi))
    (setq bb (cdr (assoc 0 (entget aab))))


    (cond ((= bb "LINE")
           (setq st (cdr (assoc 11 (entget aab))))
           (setq qed (cdr (assoc 10 (entget aab))))
           (setq ad (distance st qed)
               dd (angle st qed)
               de (angle qed st)
           )
           (cond ((= qi 0)
                  (setq qcc (getdist "\n桥位个数:<1>"))
                  (if (= qcc nil)
                  (setq qcc 1)
                  (setq qcc qcc)
                  )
               )
           )
           (cond ((= qcc 1)
                  (setq aj (/ (- ad qbl) 2.0))
               )
           )
           (cond ((> qcc 1)
                  (setq ej (/(* (/ (- ad (* qbl qcc)) (+ qcc 1)) 2) 3))
                  (setq aj ej)
               )
           )
           (setq xa (polar st dd aj))
           (setq j 1)
           (while (<= j qcc)
             (cond ((>= j 2)
                  (setq
                      aj (/ (- (- ad (* ej 2)) (* qbl qcc)) (- qcc 1))
                  )
                  (setq
                      xa (polar z2 dd aj)
                  )
                   )
             )
             (setq j (+ j 1))
             (setq
             z1 (polar xa dd 0)
             z2 (polar xa dd qbl)
             )
             (command "break" z1 z2)
           )
          )
    )


    (cond ((= bb "CIRCLE")
           (setq st (cdr (assoc 10 (entget aab))))
           (setq aeed (cdr (assoc 40 (entget aab))))
           (cond ((= qi 0)
                  (setq cb (getint "\n桥位个数:<3>"))
                  (if (= cb nil)
                  (setq cb 3)
                  (setq cb cb)
                  )
               )
           )
           (setq
             xa        (/ (/ qbl aeed) 2.0)
           )
           (setq j 1)
           (setq xb 0)
           (while (<= j cb)
             (cond ((>= j 2)
                  (setq xb (/ (* pi 2.0) cb))
                  (cond ((>= j 3)
                           (setq xb (* xb (- j 1)))
                          )
                  )
                   )
             )
             (setq
             z1 (polar st (- xb xa) aeed)
             z2 (polar st (+ xb xa) aeed)
             )
             (setq j (+ j 1))
             (command "break" z1 z2)
           )
          )
    )


    (cond ((= bb "ARC")
           (setq st (cdr (assoc 10 (entget aab))))
           (setq ast (cdr (assoc 50 (entget aab))))
           (setq sst (cdr (assoc 51 (entget aab))))
           (setq beed (cdr (assoc 40 (entget aab))))
           (setq
             xa        (/ (/ qbl beed) 2.0)
           )
           (cond ((> ast sst)
                  (cond        ((<= ast p)
                       (setq xb (+ (- p ast) g sst))
                       (setq xxb (/ xb 2.0))
                       (setq xb (+ ast xxb))
                        )
                  )
                  (cond        ((<= ast pi)
                       (setq xb (+ (- pi ast) pi sst))
                       (setq xxb (/ xb 2.0))
                       (setq xb (+ ast xxb))
                        )
                  )
                  (cond        ((<= ast g)
                       (setq xb (+ (- g ast) p sst))
                       (setq xxb (/ xb 2.0))
                       (setq xb (+ ast xxb))
                        )
                  )
                  (cond        ((<= ast (* pi 2.0))
                       (setq xb (+ (- (* pi 2.0) ast) sst))
                       (setq xxb (/ xb 2.0))
                       (setq xb (+ ast xxb))
                        )
                  )
               )
           )
           (cond ((< ast sst)
                  (setq xb (- sst ast))
                  (setq xxb (/ xb 2.0))
                  (setq xb (+ ast xxb))
               )
           )
           (setq
             z1        (polar st (- xb xa) beed)
             z2        (polar st (+ xb xa) beed)
           )
           (command "break" z1 z2)
          )
    )

    (setq qi (+ 1 qi))
)
(setvar "CMDECHO" oldecho);恢复回显
(setvar "osmode" oldmode) ;恢复原捕捉
(princ)
)

cadce 发表于 2014-8-7 10:05:02

如果有一键智能打桥位会更好，我不会]写

donghuidong2003 发表于 2014-8-7 12:50:27

这个贴子都有10年了，现在又出来了，明经真强大哟
页: [1]
查看完整版本: 我写的打缺口程序为什么有时会出错?