[LISP程序]：请教这个程序问题在哪？

morecs

斑竹，我写了个消除重复直线的程序，不知问题在哪。麻烦你帮我分析一下。
(defun c:xc()
(vl-load-com)
(setq ocmde (getvar "cmdecho"))
(setq oblip (getvar "blipmode"))
(setq oosmode (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "osmode" 0)
(setq ss (ssget '((0 . "LINE"))))
(setq n1 0)
(setq s1 (sslength ss))
(repeat s1
(setq l1 (ssname ss n1))
(setq l1_data (entget l1))
(setq pts1 (assoc 10 l1_data))
(setq p1 (cdr pts1))
(setq pte1 (assoc 11 l1_data))
(setq p2 (cdr pte1))
(setq d1 (distance p1 p2))
(setq n2 (+ n1 1))
(setq s2 (- s1 n2))
  (repeat s2
    (setq l2 (ssname ss n2))
    (setq l2_data (entget l2))
    (setq pts2 (assoc 10 l2_data))
    (setq q1 (cdr pts2))
    (setq pte2 (assoc 11 l1_data))
    (setq q2 (cdr pte2))
    (setq d2 (distance q1 q2))
    (setq CURVE1 (vlax-ename->vla-object (ssname SS N1)))
    (setq CURVE2 (vlax-ename->vla-object (ssname SS N2)))
    (cond (> d1 d2)
      (a1)
    )
    (cond (< d1 d2)
      (a2)
    )
    (cond (= d1 d2)
      (a3)
    )
    (setq n2 (+ 1 n2))
  )
   (setq n1 (+ 1 n1))
)
(setq ss nil)
(setvar "blipmode" oblip)
(setvar "cmdecho" ocmde)
(setvar "osmode" oosmode)
(princ)
)
(defun a1()
      (setq t1 (vlax-curve-getdistatparam CURVE1 q1))
      (setq t2 (vlax-curve-getdistatparam CURVE1 q2))
      (cond (and (> t1 0) (> t2 0))
          (if (> t1 t2)
                (progn
                      (command "line" p1 q2 "")
                      (command "line" q1 p2 "")
                )
                (progn
                      (command "line" p1 q1 "")
                      (command "line" p2 q2 "")
                )
           )
       (command "erase" l1 "")
       )
       (cond (and (> t1 0) (= t2 0))
             (if  (= q2 p1)
                  (progn
                        (command "line" p2 q1 "")
                  )
                  (progn
                        (setq dd1 (distance p1 q2))
                        (setq dd2 (distance p2 q2))
                        (if (> dd1 dd2)
                            (command "line" p1 q1 "")
                            (command "line" p2 q1 "")
                        )
                   )
              )
        (command "erase" l1 "")
        )
       (cond (and (= t1 0) (> t2 0))
             (if  (= q1 p1)
                  (progn
                        (command "line" q2 p2 "")
                  )
                  (progn
                        (setq ddd1 (distance p1 q1))
                        (setq ddd2 (distance p2 q1))
                        (if (> ddd1 ddd2)
                            (command "line" q2 p1 "")
                            (command "line" q2 p2 "")
                        )
                   )
              )
        (command "erase" l1 "")
        )
)                    
(defun a2()
      (setq tt1 (vlax-curve-getdistatparam CURVE2 p1))
      (setq tt2 (vlax-curve-getdistatparam CURVE2 p2))
      (cond (and (> tt1 0) (> tt2 0))
         (command "erase" l1 "")
      )
       (cond (and (> tt1 0) (= tt2 0))
             (if  (= p2 q1)
                  (progn
                        (command "erase" l1 "")
                  )
                  (progn
                        (setq dp1 (distance q1 p2))
                        (setq dp2 (distance q2 p2))
                        (if (> dp1 dp2)
                            (command "line" q2 p2 "")
                            (command "erase" l1 "")
                        )
                   )
              )
        )
        (cond (and (= tt1 0) (> tt2 0))
             (if  (= q1 p1)
                  (progn
                        (command "erase" l1 "")
                  )
                  (progn
                        (setq dpp1 (distance q1 p1))
                        (setq dpp2 (distance q2 p1))
                        (if (> dpp1 dpp2)
                            (command "line" q2 p1 "")
                            (command "line" p1 q1 "")   
                        )
                        (command "erase" l1 "")
                   )
              )
          )
)
(defun a3()
      (cond (and (= p1 q1) (= p2 q2))
            (command "erase" l1 "")
       )
      (cond (and (= p1 q2) (= p2 q1))
            (command "erase" l1 "")
       )
)

XDSoft

最初由 morecs 发布
[B]斑竹，我写了个消除重复直线的程序，不知问题在哪。麻烦你帮我分析一下。
(defun c:xc()
(vl-load-com)
(setq ocmde (getvar "cmdecho"))
(setq oblip (getvar "blipmode"))
(setq oosmode (getvar "osmode"))
... [/B]

你程序运行有什么结果吗？哪些结果不是你的预期，详细说给大家吧。

morecs

没有什么反应，只是说选定了多少直线，
没有提示错误信息。

aeo

就看最后几行:
(defun a3()
(cond (and (= p1 q1) (= p2 q2))
(command "erase" l1 "")
)
(cond (and (= p1 q2) (= p2 q1))
(command "erase" l1 "")
)
)

cond的用法就不对:
如果我没理解错的话:

2. 
   
3. (defun a3()
   
4. (cond ((and (= p1 q1) (= p2 q2))
   
5.              (command "erase" l1 "")
   
6.          )
   
7.          ( (and (= p1 q2) (= p2 q1))
   
8.                 (command "erase" l1 "")
   
9.          )
   
10.   )
    
11. )
    

<br /> (defun a3()<br /> (cond ((and (= p1 q1) (= p2 q2))<br />              (command "erase" l1 "")<br />          )<br />          ( (and (= p1 q2) (= p2 q1))<br />                 (command "erase" l1 "")<br />          )<br />   )<br /> )<br />

不过又好像是if



看来你要看一下cond的帮助了.

on/off

=会不会有精度问题？

ll_j

“=”函数的参数必须是数字或字符串，判断点（表）相同应该使用“equal”函数。

morecs

;;消除直线间重线的程序，先比较第一条与后面所有的直线是否重线
;;
(defun c:xc1(/ ss n1 n2 s1 s2 d1 d2 d11 d12 d21 d22 l1 l2)
                (setq ocmde (getvar "cmdecho"))
                (setq oblip (getvar "blipmode"))
                (setq oosmode (getvar "osmode"))
                (setvar "cmdecho" 0)
                (setvar "blipmode" 0)
                (setvar "osmode" 0)
                (setq ss (ssget '((0 . "LINE"))))
                (setq n1 0)
                (setq s1 (sslength ss))
       (repeat s1
                (setq l1 (ssname ss n1))
                (setq l1_data (entget l1))
                (setq pts1 (assoc 10 l1_data))
                (setq p1 (cdr pts1))
                (setq pte1 (assoc 11 l1_data))
                (setq p2 (cdr pte1))
                (setq d1 (distance p1 p2))
                (setq n2 (+ n1 1))
                (setq s2 (- s1 n2))
           (repeat s2
                (setq l2 (ssname ss n2))
                (setq l2_data (entget l2))
                (setq pts2 (assoc 10 l2_data))
                (setq q1 (cdr pts2))
                (setq pte2 (assoc 11 l1_data))
                (setq q2 (cdr pte2))
                (setq d2 (distance q1 q2))
                (setq d11 (distance p1 q1))
                (setq d12 (distance p1 q2))
                (setq d21 (distance p2 q1))
                (setq d22 (distance p2 q2))
                (cond ((> d1 d2) (a1));;首先判断哪条直线长，在判断短直线两个端点是否在长直线上
                      ((< d1 d2) (a2))
                      ((= d1 d2) (a3))
                      (t         (princ))
                )
                      (setq n2 (+ 1 n2))
            )
                      (setq n1 (+ 1 n1))
        )
                (setq ss nil)
                (setvar "blipmode" oblip)
                (setvar "cmdecho" ocmde)
                (setvar "osmode" oosmode)
                (princ)
)      
(defun a1()
    (cond
         ((and (= d1 (+ d11 d21)) (= d1 (+ d12 d22)));;两端点在长直线上
               (if (< d11 d12) ;;判断短直线的方向
                   (progn
                       (command "line" p1 q1 "")
                       (command "line" q2 p2 "")
                       (command "erase" l1 "")
                    )
                    (progn
                        (command "line" p2 q1 "")
                        (command "line" q2 p1 "")
                        (command "erase" l1 "")
                     )
                )
          )
          ((and (/= d1 (+ d11 d21)) (= d1 (+ d12 d22)));; 起点不在长直线上
                (if (< d11 d21) ;;判断短直线的方向
                    (progn
                          (command "line" q2 p2 "")
                          (command "erase" l1 "")
                    )
                    (progn
                          (command "line" q2 p1 "")
                          (command "erase" l1 "")
                    )
                 )
          )
          ((and (= d1 (+ d11 d21)) (/= d1 (+ d12 d22)));; 终点不在长直线上
                (if (< d12 d22) ;;判断短直线的方向
                    (progn
                          (command "line" p2 q1 "")
                          (command "erase" l1 "")
                    )
                    (progn
                          (command "line" p1 q1 "")
                          (command "erase" l1 "")
                    )
                )
          )
          (t         (princ))
       )
)
(defun a2()
      (cond
           ((and (= d2 (+ d11 d12)) (= d2 (+ d21 d22)));;两端点在长直线上
                          (command "erase" l1 "")
           )
           ((and (/= d2 (+ d11 d12)) (= d2 (+ d21 d22)));;起点在长直线上
                 (if (< d11 d12) ;;判断短直线的方向
                      (progn
                          (command "line" p1 q1 "")
                          (command "erase" l1 "")
                       )
                       (progn
                          (command "line" q2 p1 "")
                          (command "erase" l1 "")
                       )
                  )
            )
            ((and (= d2 (+ d11 d12)) (/= d2 (+ d21 d22));; 终点不在长直线上
                  (if (< d21 d22) ;;判断短直线的方向
                      (progn
                           (command "line" p2 q1 "")
                           (command "erase" l1 "")
                       )
                       (progn
                           (command "line" q2 p2 "")
                           (command "erase" l1 "")
                       )
                  )
             )
             (t         (princ))
       )         
)
(defun a3() ;;判断两点是否同一点     
              (cond
                    ((and (= d11 0 ) (= t22 0))
                         (command "erase" l1 "")
                    )
                    ((and (= d12 0) (= d21 0))  
                           (command "erase" l1 "")
                    )
                    (t         (princ))
               )
)
晓东工具箱里的消除重线的命令好用是好用，但它连短线都要消除，而短线我这里是万万不可消除，我自己编的又行不通，各位大侠麻烦你们帮帮这个忙，谢谢！！！