[求助]：前辈请进！！！

gyc2001

我也不知这两个程序是那个前辈所编～一个的是画外墙程序，一个是画内墙的。可是在2006里每次运行这两个程序捕捉点都要重设一次，请问各位大师那位能给改一下。我在这儿谢谢各位了。
程序如下：
外墙的
(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:wwall(/ th ss bp sp ep pt1 pt2 pt3 pt4 n tmp bbp ssp)
  (setq old_err *error*)
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (command "layer" "m" "wall" "c" "w" "wall" "")
  (setvar "osmode" 32)

  (if (= thw nil) (setq thw 360.0))
  (setq th (getreal (strcat "\n外墙厚<" (rtos thw 2 0) ">:")))
    (if (= th nil) (setq th thw))
    (setq thw th)

  (if (= thlsw nil) (setq thlsw 240.0))
  (setq thls (getreal (strcat "\n轴线外的墙厚<" (rtos thlsw 2 0) ">:")))
    (if (= thls nil) (setq thls thlsw))           ;thls轴线外墙厚
    (setq thlsw thls)

  (setq thrx (- th thls))                         ;thrx轴线内墙厚

  (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)) thls))
    (setq pt2 (polar pt1 ang1 dis1))
    (if (= 0 n)
      (command "line" pt1 pt2 "")
      (command "line" pt11 pt2 "")
    )
    (setq ss (ssadd))
    (setq ss (ssget "L"))
    (setq pt3 (polar bp (- ang1 (* pi 0.5)) thrx))
    (setq pt4 (polar pt3 ang1 dis1))
    (if (= 0 n)
      (command "line" pt3 pt4 "")
      (command "line" pt33 pt4 "")
    )
    (setq ss (ssadd (entlast) ss))
    (if (= 1 tmp) (command "erase" ss ""))
    (if (= nil ep)
      (progn
        (if (= 1 tmp)
          (progn
            (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 dis2 (distance sp ep))
        (setq dis3 (* thls (tan ang3)))
        (setq dis4 (* thrx (tan ang3)))

        (setq pt1 (polar bp (+ ang1 (* pi 0.5)) thls))
        (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 "")
        )
        (setq pt3 (polar bp (- ang1 (* pi 0.5)) thrx))
        (setq pt4 (polar pt3 ang1 (- dis1 dis4)))
        (if (= 0 n)
          (progn
            (command "line" pt3 pt4 "")
            (setq sss (ssadd (entlast) sss))
          )
          (command "line" pt33 pt4 "")
        )
      )
      (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 dis2 (distance sp ep))
        (setq dis3 (* thls (tan ang3)))
        (setq dis4 (* thrx (tan ang3)))
        (setq pt1 (polar bp (+ ang1 (* pi 0.5)) thls))
        (setq pt2 (polar pt1 ang1 (+ dis1 dis3)))
        (command "erase" ss "")
        (command "line" pt11 pt2 "")
        (setq ss (ssadd))
        (setq ss (ssget "L"))
        (setq pt3 (polar bp (- ang1 (* pi 0.5)) thrx))
        (setq pt4 (polar pt3 ang1 (- dis1 dis4)))
        (command "line" pt33 pt4 "")
        (setq ss (ssadd (entlast) ss))
        (command "line" pt2 pte1 "")
        (command "line" pt4 pte2 "")
        (setq tmp 1)
      )
    )
    (if (= 0 n)
      (setq pte1 pt2 pte2 pt4)
    )
    (setq pt11 pt2 pt33 pt4)
    (setq bp sp sp ep n 1)
    (if (equal bbp ep)
      (setq ep ssp)
      (setq ep nil)
    )
  )
  (princ)  
)






这是内墙的：
(defun *error*(st)
  (if (and (/= st "Function cancelled")
           (/= st "quit / exit abort")
      )
      (princ (strcat "错误: " st))
  )
  (setq *error* old_err)
  (princ)
)

(defun sort (l tst1 tst2 / lt ltem vmax vmin l1 l2 l3
             lt0 ltem0 ltem1 l30 vmax0 vmin0 l10 l20)
  (setq ltem (mapcar 'car l)                    ;ltem :  取出l的第一项形成的表
        vmin (1- (apply 'min ltem))             ;vmin :  是一个比ltem中最小的数还小的数
  )
  (while (< vmin (setq vmax (apply 'max ltem)))        ;从ltem中取出最大值
    (setq l1 l l3 nil ltem (subst vmin vmax ltem))     ;去掉最大值
    (while (setq l2 (assoc vmax l1))                   ;取出最大值所对应的项
      (setq l1 (cdr (member l2 l1)))                   ;处理相同的值
      (setq l3 (cons l2 l3))
    )
    (progn                                         ;如果X相等, 对Y排序
      (setq ltem0 (mapcar 'cadr l3)
            ltem1 (mapcar 'car l3)
            l30   (mapcar 'cdr l3)
            vmin0 (1- (apply 'min ltem0))
      )
      (while (< vmin0 (setq vmax0 (apply 'max ltem0)))
        (setq l10 l30 ltem0 (subst vmin0 vmax0 ltem0))
        (while (setq l20 (assoc vmax0 l10))
          (setq l10 (cdr (member l20 l10)))
          (setq lt0 (cons l20 lt0))
        )
      )
      (setq l3 (mapcar 'cons ltem1 lt0))
      (if tst1 (setq l3 (reverse l3)))                 ;tst1,tst2控制排序顺序
    )
    (setq lt (append l3 lt))
  )
  (if tst2 (setq lt (reverse lt)) (setq lt lt))
)

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

(defun dxf1 (code en)
  (cdr (assoc code (entget en)))
)

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

(defun pross (bp sp bp0 sp0 bpm spm ne tst / tem ss ss0 n el ip lpt lpt0
              a en en0 pt pt0 ne ne0 i j tst1 tst2 t1 t2 t10 t20)
  (setq ne0 ne)
  (if (or (> (car bp) (car sp))
          (and (= (car bp) (car sp)) (> (cadr bp) (cadr sp)))
      )
    (setq t1 nil t2 t tem T)
    (setq t1 nil t2 nil tem T)
  )
  (if (or (> (car bp0) (car sp0))
          (and (= (car bp0) (car sp0)) (> (cadr bp0) (cadr sp0)))
      )
    (setq t10 nil t20 t)
    (setq t10 nil t20 nil)
  )
  (setq ss nil)
  (if (setq ss (ssget "c" bp sp))
    (progn
      (setq n 0)
      (repeat (sslength ss)
        (setq el (entget (setq en (ssname ss n))))
        (if (and (= (dxf 0 el) "LINE")
                 (= (dxf 8 el) "WALL")
                 (setq ip (inters bp sp (dxf 10 el) (dxf 11 el)))
            )                    ; ip 交点
            (if (> (distance ip bp) 0.01) (setq lpt (cons ip lpt)))
        )
        (setq n (1+ n))
      )         ; repeat 找出所有的交点并形成表lpt
      (if (/= nil lpt) (setq lpt (sort lpt t1 t2)))
    )
  )

  (setq ss0 nil)
  (if (setq ss0 (ssget "c" bp0 sp0))
    (progn
      (setq n 0)
      (repeat (sslength ss0)
        (setq el (entget (setq en (ssname ss0 n))))
        (if (and (= (dxf 0 el) "LINE")
                 (= (dxf 8 el) "WALL")
                 (setq ip (inters bp0 sp0 (dxf 10 el) (dxf 11 el)))
            )                    ; ip 交点
            (if (> (distance ip bp0) 0.01) (setq lpt0 (cons ip lpt0)))
        )
        (setq n (1+ n))
      )         ; repeat 找出所有的交点并形成表lpt
      (if (/= nil lpt0) (setq lpt0 (sort lpt0 t10 t20)))
    )
  )

  (setq i 1)
  (if (/= nil lpt)
    (foreach pt lpt
      (setq ss nil)
      (setq ss (ssget "c" (polar pt (* pi 1.25) 1) (polar pt (* pi 0.25) 1)))
      (setq en (ssname ss 0))
      (setq j 1)
      (foreach pt0 lpt0
        (setq ss0 nil)
        (setq ss0 (ssget pt0))
        (setq en0 (ssname ss0 0))
        (if (= i j)
          (progn
            (if (equal en en0)
              (command "break" en pt pt0)
              (progn
                (setq ip (inters (dxf1 10 en) (dxf1 11 en) (dxf1 10 en0) (dxf1 11 en0)))
                (if (= ip nil)
                  (progn
                    (if (< (distance (dxf1 10 en) pt) (distance (dxf1 11 en) pt))
                      (command "break" en pt (dxf1 10 en))
                      (command "break" en pt (dxf1 11 en))
                    )
                    (if (< (distance (dxf1 10 en0) pt0) (distance (dxf1 11 en0) pt0))
                      (command "break" en0 pt0 (dxf1 10 en0))
                      (command "break" en0 pt0 (dxf1 11 en0))
                    )
                  )
                  (progn
                    (if (< (distance (dxf1 10 en) ip) 0.001) (setq ip (dxf1 10 en)))
                    (if (< (distance (dxf1 11 en) ip) 0.001) (setq ip (dxf1 11 en)))
                    (command "break" en pt ip)
                    (if (< (distance (dxf1 10 en0) ip) 0.001) (setq ip (dxf1 10 en0)))
                    (if (< (distance (dxf1 11 en0) ip) 0.001) (setq ip (dxf1 11 en0)))
                    (command "break" en0 pt0 ip)
                  )
                )
              )
            )
          )
        )
        (setq j (1+ j))
      )
      (setq i (1+ i))
    )
  )

      (setq tst1 tst)
      (if (/= nil lpt)
        (progn
          (foreach pt lpt
            (if (= tst1 T)
              (if (> (distance bp pt) 500) (setq ne 0 tst1 nil))
            )
            (if (= 0 ne)
              (progn
                (command "line" bp pt "")
                (setq ne 1)
              )
              (setq ne 0)
            )
            (setq bp pt)
          )
        )
      )
      (if (= 0 ne) (command "line" bp sp ""))

      (setq tst2 tst)
      (if (/= nil lpt0)
        (progn
          (foreach pt0 lpt0
            (if (= tst2 T)
              (if (> (distance bp0 pt0) 500) (setq ne0 0 tst2 nil))
            )
            (if (= 0 ne0)
              (progn
                (command "line" bp0 pt0 "")
                (setq ne0 1)
              )
              (setq ne0 0)
            )
            (setq bp0 pt0)
          )
        )
      )
      (if (= 0 ne0) (command "line" bp0 sp0 ""))  
)

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

(defun C:nwall(/ th bp sp n ang1 dis1 ss ang2 ang3 ang4 dis2 dis3 dis4
             ep pt1 pt2 pt3 pt4 pt11 pt33 ne tst ts loop)
  (setq old_err *error*)
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (command "layer" "m" "wall" "c" "w" "wall" "")
  (princ "\n说明: 缺省为INT捕捉方式, 如不是请自己敲入 !")

  (if (= th0 nil) (setq th0 240.0))
  (setq th (getreal (strcat "\n内墙厚<" (rtos th0 2 0) ">:")))
    (if (= th nil) (setq th th0))
    (setq th0 th)

  (setq loop T)
  (setvar "osmode" 32)
  (while loop
    (initget 1 "R")
    (setq bp (getpoint "\nR参照点/<第一点>: "))
    (cond
      ((eq bp "R") (progn
                     (setq bp (getpoint "\n参照点: "))
                     (setq bp (getpoint bp "\n@X,Y 或 @长度<角度: "))
                     (setq loop nil)
                    ))
      (t (setq loop nil))
    )
  )
  (setvar "osmode" 0)
  (if (= nil bp) (quit))
  (setvar "osmode" 32)
  (setq sp (getpoint bp "\n下一点: "))
  (if (= nil sp) (quit))
  (setvar "osmode" 0)
  (setq n 0 tst T)
  (while tst
    (setq ang1 (angle bp sp))
    (setq dis1 (distance bp sp))  
    (setq pt1 (polar bp (+ ang1 (* pi 0.5)) (/ th 2.0)))
    (setq pt2 (polar pt1 ang1 dis1))
    (setq pt3 (polar bp (- ang1 (* pi 0.5)) (/ th 2.0)))
    (setq pt4 (polar pt3 ang1 dis1))
   
    (if (= 0 n)
      (command "line" pt1 pt2 "")
      (command "line" pt11 pt2 "")
    )
    (setq ss (ssadd))
    (setq ss (ssget "L"))
    (if (= 0 n)
      (command "line" pt3 pt4 "")
      (command "line" pt33 pt4 "")
    )
    (setq ss (ssadd (entlast) ss))
    (setvar "osmode" 32)
    (setq ep (getpoint sp "\n下一点: "))
    (setvar "osmode" 0)
    (if (= nil ep)
      (progn
        (setq ep sp)
        (setq tst nil)
      )
    )
    (setq ang2 (angle sp ep))
    (setq ang3 (- pi ang1))
    (setq ang4 (- (* pi 2) ang2))
    (setq ang3 (- (/ pi 2) (/ (- ang3 ang4) 2)))
    (setq dis2 (distance sp ep))
    (setq dis3 (* (/ th 2) (tan ang3)))
    (setq dis4 (* (/ th 2) (tan ang3)))
    (if (= sp ep) (setq dis3 0 dis4 0))
    (setq pt1 (polar bp (+ ang1 (* pi 0.5)) (/ th 2.0)))
    (setq pt2 (polar pt1 ang1 (+ dis1 dis3)))
    (setq pt3 (polar bp (- ang1 (* pi 0.5)) (/ th 2.0)))
    (setq pt4 (polar pt3 ang1 (- dis1 dis4)))
    (command "erase" ss "")
    (if (= 0 n)
      (progn
        (setq ne 1 ts T)
        (pross pt1 pt2 pt3 pt4 bp sp ne ts)
      )
      (progn
        (setq ne 0 ts nil)
        (pross pt11 pt2 pt33 pt4 bp sp ne ts)
      )
    )
    (setq pt11 pt2 pt33 pt4)
    (setq bp sp sp ep n 1 ts nil)
  )
  (princ)  
)