[ARX程序]：我的线变双的程序有一个BUG, 谁来帮忙? 谢谢

yly

我的线变双的程序有一个BUG, 谁来帮忙? 谢谢


error: bad argument type
(+ A:PI2 (ANGLE P1 P2))
(SETQ A1 (ASSOC 10 EN) A2 (ASSOC 11 EN) P1 (CDR A1) P2 (CDR A2) LN (CDR (ASSOC 6 EN)) A (+ A:PI2 (ANGLE P1 P2))) (COND ((= "ARC" A0) (SETQ SS1 (SSADD SN SS1))) ((= "LINE" A0) (SETQ A1 (ASSOC
10 EN) A2 (ASSOC 11 EN) P1 (CDR A1) P2 (CDR A2) LN (CDR (ASSOC 6 EN)) A (+ A:PI2 (ANGLE P1 P2))) (IF (< (DISTANCE P1 P2) 90) (ENTDEL SN) (PROGN (IF (AND
N (> (ATOI LN) 0)) (SETQ X (ATOI LN) C (IF (> X 9999) 10 1) B (REM X (* 100
C)) W (/ (- X B) (* 20 C C)) B (* B (/ 10 C)) W1 (+ W B) W2 (- W B)) (SETQ W1
120 W2 120 W 120)) (SETQ P3 (POLAR P1 A (- W1)) WX (IF (< WX W) W WX)) (COMMAND
"copy" SN "" P1 P3) (SETQ SS2 (SSADD (ENTLAST) SS2)) (SETQ P3 (POLAR P2 A W2)
P4 (POLAR P1 A W2) EN (SUBST (CONS 10 P3) A1 EN) EN (SUBST (CONS 11 P4) A2 EN))
(ENTMOD EN) (SETQ SS2 (SSADD SN SS2))))))
(WHILE (SETQ I (1+ I) SN (SSNAME SS I)) (SETQ EN (ENTGET SN) A0 (CDR (ASSOC 0
EN))) (COND ((= "ARC" A0) (SETQ SS1 (SSADD SN SS1))) ((= "LINE" A0) (SETQ A1
(ASSOC 10 EN) A2 (ASSOC 11 EN) P1 (CDR A1) P2 (CDR A2) LN (CDR (ASSOC 6 EN)) A
(+ A:PI2 (ANGLE P1 P2))) (IF (< (DISTANCE P1 P2) 90) (ENTDEL SN) (PROGN (IF
(AND LN (> (ATOI LN) 0)) (SETQ X (ATOI LN) C (IF (> X 9999) 10 1) B (REM X (*
100 C)) W (/ (- X B) (* 20 C C)) B (* B (/ 10 C)) W1 (+ W B) W2 (- W B)) (SETQ
W1 120 W2 120 W 120)) (SETQ P3 (POLAR P1 A (- W1)) WX (IF (< WX W) W WX))
(COMMAND "copy" SN "" P1 P3) (SETQ SS2 (SSADD (ENTLAST) SS2)) (SETQ P3 (POLAR
P2 A W2) P4 (POLAR P1 A W2) EN (SUBST (CONS 10 P3) A1 EN) EN (SUBST (CONS 11
P4) A2 EN)) (ENTMOD EN) (SETQ SS2 (SSADD SN SS2)))))))
(DLIN)
(PROGN (DLIN) (DARC))
(IF SS (PROGN (DLIN) (DARC)))
(C:DL)
*Cancel*



; The following is the code:
(defun c:dl ( )
  (setq ob(getvar "useri1") os(getvar "osmode") )
  (mapcar 'setvar '("highlight" "osmode" "orthomode" "cmdecho")
                  '(1 0 0 0) )
;  (command "layer" "off" "dim*" "off" stm "")
  (princ "\n选取要变双的墙线 <当前层全部墙线>:")
  (if (not (setq ss(ssget)))
    (progn
      (setq st stw a(substr st 5) st0(if (> (atoi a) 0) a st)
            as(assoc st0 lcblst) h(last as) )
      (if (minusp h) (princ "\n当前层墙线已经变双.")
        (progn
          (setq a(- h) b(cdr(reverse as))
                x1(reverse(cons a b)) lcblst(subst x1 as lcblst)
                ss(ssget "x" (list (cons 8 st))) )
        )
      )
    )
  )
  (setvar "highlight" 0) (setvar "pickbox" 0)
  (if ss (progn (dlin) (darc)) )
  (command "layer" "on" stm "")
  (mapcar 'setvar '("highlight" "orthomode" "pickbox" "osmode")
                   (list 1 1 ob os) )
  (setq c:dob nil)
)
(defun dlin(/ plst blst clst pp1 pp2 pp3 )
   (setq i -1 wx 0 ss1(ssadd) ss2(ssadd) )
   (while (setq i(1+ i) sn(ssname ss i))
     (setq en(entget sn) a0(cdr(assoc 0 en)) )
     (cond
       ((= "ARC" a0) (setq ss1(ssadd sn ss1)) )
       ((= "LINE" a0)
         (setq a1(assoc 10 en) a2(assoc 11 en) p1(cdr a1) p2(cdr a2)
               ln(cdr(assoc 6 en)) a(+ a:pi2 (angle p1 p2)) )
         (if (< (distance p1 p2) 90)
             (entdel sn)
             (progn
               (if (and ln (> (atoi ln) 0) )
                   (setq x(atoi ln) c(if (> x 9999) 10 1)
                         b(rem x (* 100 c)) w(/ (- x b) (* 20 c c))
                         b(* b (/ 10 c)) w1(+ w b) w2(- w b) )
                   (setq w1 120 w2 120 w 120)
               )
               (setq p3(polar p1 a (- w1)) wx(if (< wx w) w wx) )
               (command "copy" sn "" p1 p3) (setq ss2(ssadd (entlast) ss2))
               (setq p3(polar p2 a w2) p4(polar p1 a w2)
                     en(subst (cons 10 p3) a1 en)
                     en(subst (cons 11 p4) a2 en) )
               (entmod en) (setq ss2(ssadd sn ss2))
             )
         )
       ); line
     )
   )
   (setq wx(* 3 wx) i -1 clst '() )
   (while (setq i(1+ i) sn(ssname ss2 i))
     (setq en(entget sn) p1(cdr(assoc 11 en)) p2(cdr(assoc 10 en))
           a (mapcar '- (mapcar 'min p1 p2) '(20 20) )
           b (mapcar '+ (mapcar 'max p1 p2) '(20 20) )
           ss(ssdel sn (ssget "c" a b)) j -1 plst '())
     (while (setq j(1+ j) sn1(ssname ss j))
       (setq en(entget sn1) p3(cdr(assoc '10 en)) p4(cdr(assoc '11 en))
             pt(if p4 (inters p1 p2 p3 p4) )
       )
       (if pt
         (setq a(if (equal p3 pt 0.001) (left p4 p1 p2) (left p3 p2 p1) )
               d(distance p1 pt) plst(cons (list d a pt) plst) )
       )
     )
     (if plst
       (progn
        (setq c(mapcar 'car plst) mn -1 blst '() )
        (while (< mn (setq mx(apply 'max c)))
           (setq c(subst mn mx c) blst(cons mx blst) )
        )
        (setq w2(car blst) b(assoc w2 plst) a1(cadr b) p0(last b))
        (if (> a1 0)
            (command "break" (cons sn (list p1)) p0 ^C)
        )
        (setq j -1 e(entlast) )
        (while (setq j(1+ j) w2(nth j blst) )
          (setq b(assoc w2 plst) a(cadr b) )
          (if (minusp a)
              (progn
                 (while (and (setq j(1+ j) w2(nth j blst))
                             (minusp (setq b1(assoc w2 plst) a(cadr b1)) )
                        )
                 )
                 (if w2 (command "break" (list sn (last b)) (last b1) ^C) )
              )
          )
        )
        (setq w2(last blst) b(assoc w2 plst) a(cadr b) pt(last b))
        (if (minusp a)
            (command "break" (cons sn (list p2)) pt ^C)
            (setq clst(cons (list p2 pt sn) clst))
        )
        (if (minusp a1) (setq e(entnext e) e(if e e sn)
                              clst(cons (list p1 p0 e) clst) )
        )
       ); progn
       (setq clst(cons (list p1 p2 sn) clst)
             clst(cons (list p2 p1 sn) clst) )
     )
   )
   (setq j 0)
   (while (setq c(car clst) clst(cdr clst))
     (setq p1(car c) w wx b nil j -1)
     (while (setq j(1+ j) d(nth j clst) )
        (if (< (setq a (distance p1 (car d))) w) (setq b d w a) )
     )
     (if b
       (progn
         (setq d b clst(rev d clst) p2(car d) sn(last c)
               pt(inters p1 (cadr c) p2 (cadr d) nil) )
         (if pt
           (command "change" sn (last d) "" pt)
           (if (and (not (equal p1 p2 0.001)) (entget sn) )
             (progn
               (command "copy" sn "" '(0 0) "")
               (setq sn(entlast) e(entget sn) a0(assoc 10 e) )
               (if (equal p1 (cdr a0) 0.1)
                 (setq e(subst (cons 11 p1) (assoc 11 e) e)
                       e(subst (cons 10 p2) (assoc 10 e) e) )
                 (setq e(subst (cons 10 p1) (assoc 10 e) e)
                       e(subst (cons 11 p2) (assoc 11 e) e) )
               )
               (entmod e)
             )
           )
         )
       )
     )
   )
)
(defun left(p1 p2 p3 / p c)
   (setq p p3)
   (apply '+ (mapcar '(lambda (b)
      (setq c(- (* (car p) (cadr b)) (* (cadr p) (car b))) p b )
                    c ) (list p1 p2 p3)
             )
   )
)
(defun darc ( / p00 p01 p02 ab p12)
   (setq i -1)
   (while (setq i(1+ i) sn(ssname ss1 i))
      (setq en1(entget sn) ln(cdr(assoc '6 en1)) r(cdr(assoc '40 en1))
            p00(cdr(assoc '10 en1)) a(cdr(assoc 50 en1)) b(cdr(assoc 51 en1))
            p01(polar p00 a r) p02(polar p00 b r) p12(midp p01 p02)
            ab(/ (+ a b) 2) )
      (if (> a b) (setq ab(- ab pi)))
      (if (and ln (> (atoi ln) 0) )
        (progn
          (setq x(atoi ln) c(if (> x 9999) 10 1) b(rem x (* 100 c))
                wx(/ (- x b) (* 10 c c)) b(* b (/ 10 c)) )
          (if (> wx b) (setq w(/ wx 2) w1(- w b) w2(+ w b) )
                       (setq w(/ b 2) b wx w1(+ w b) w2(- w b))
          )
        )
        (setq w1 120 w2 120 w 120)
      )
      (setq r1(- r w1) r2(+ r w2) sl(entlast) )
      (command "offset" w1 (list sn p01) (polar p00 a r1) ^c
               "offset" w2 (list sn p01) (polar p00 a r2) ^c "erase" sn "")
      (setq s1(entnext sl) s2(entlast) wx(* w 3))
      (j01 p01 T) (j01 p02 nil)
   )
)
(defun j01(p fh / )
    (setq p3(polar p ab wx) p4(polar p ab -10)
          ss(ssget "c" p3 p4) j -1 sn0 nil)
    (if ss
       (while (setq j(1+ j) sn(ssname ss j))
          (setq en(entget sn) a(cdr(assoc 0 en)))
          (if (or (equal sn s1) (equal sn s2) (/= a "LINE") )
             nil (setq j 99 sn0 sn)
          )
       )
    )
    (if sn0
      (progn
        (setq p1(cdr(assoc '10 en)) p2(cdr(assoc '11 en))
              d (distance p1 p2) a(angle p1 p2) tn T an nil)
        (cond
          ((> d wx)
            (setq pt(inters p1 p2 p3 p4 nil) )
            (command "break" (list sn0 pt) pt ^c)
            (if (and pt (entget sn0) )
              (progn
                (setq p1(midp p1 pt) p2(midp p2 pt) sl(entlast)
                      en(entget sl) a0(assoc 10 en) a1(assoc 11 en)
                      a2(subst 11 10 a0) a3(subst 10 11 a1)
                      en(subst a2 a0 en) en(subst a3 a1 en)
                      p3(list sl pt) p4(list sn0 pt) an T)
                (entmod en)
                (if (> (distance p1 p00) (distance p2 p00))
                    (setq p1 p3 p2 p4)
                    (setq p2 p3 p1 p4)
                )
              )
              (setq tn nil)
            )
          )
          (T (command "erase" sn0 "")
            (cond
              (fh (setq p0 p1 p1 p2 p2 p0) )
              (T  (if (setq ss(ssget p2))
                      (progn
                         (setq sn(ssname ss 0)
                               en(entget sn) a0(assoc 10 en) a1(assoc 11 en)
                               a2(subst 11 10 a0) a3(subst 10 11 a1)
                               en(subst a2 a0 en) en(subst a3 a1 en) )
                         (entmod en)
                      )
                  )
              )
            )
          ); t
        )
        (if tn
          (progn
            (setq p3(midp p (polar p00 ab r1)) p4(midp p (polar p00 ab r2))
                  p3(list s1 p3) p4(list s2 p4) )
            (if (or an (ssget p1)) (command "fillet" p3 p1) )
            (if (or an (ssget p2)) (command "fillet" p4 p2) )
          )
        )
      ); progn
    )
)

ll_j

a:pi2为何值？c:dob为何值？
程序没有调试通过时，尽量不要改变系统变量，除非在程序中非使用不可。

长清

最初由 yly 发布
[B]我的线变双的程序有一个BUG, 谁来帮忙? 谢谢


error: bad argument type
(+ A:PI2 (ANGLE P1 P2))
(SETQ A1 (ASSOC 10 EN) A2 (ASSOC 11 EN) P1 (CDR A1) P2 (CDR A2) LN (CDR (ASSOC 6 EN)) A (+ A:PI2 (ANGL... [/B]

你的变量A:PI2是从那里来的，程序中根本没有产生A：PI2的地方。另外，你的这个变量名也太怪了，居然用冒号（不是不可以，我想起C中的 .  和 :: 来了，太别扭。

saintdog

”BAD ARGUEMENT TYPE“是错误的变量类型之意；
我查找程序时主要是查变量数量及使用情况，我发现，程序中定义的变量：PP1、PP2、PP3都未使用过，而变量P1、P2、P3均有反复出现,是否操写错误？P0未定义过,而P00和P0在程序中都有用到，是否应补加定义变量P0？pi2是什么，是2*pi(2*3.1415926)吗？

LUCAS

error: bad argument type: numberp:  a:pi2
error: no function definition: REV
error: no function definition: MIDP
看来bug太多,这很难帮你!!
可否再说清楚它的详细功能!!

梦断江南

欢迎，你能否说说你的编程思路，和如何解决相交墙线的修剪问题的？

cy956

a:pi2即二分一pi，这是abd定义的一个公变量。

程序还没看，是套abd的作法吗？

cy956

就是abd2.0的单线变双。

但要在abd那样定义下才能用。时间长了，也记不清了。
一是线宽用线型定义，另一是几个abd的公变量要定义。
不过我劝你别用，abd2.0的变双准确率还比不上tch，
虽然tch也经常出错。

saintdog

在LISP中(+ a:pi2 (angle p1 p2)) 这句运行通不过呀，得改善一下。