明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1641|回复: 0

请教这个程序问题在哪?

[复制链接]
发表于 2003-9-20 12:07:00 | 显示全部楼层 |阅读模式
斑竹 我编了消除重复直线的程序,不知问题在哪,麻烦你分析一下。谢谢!!!

(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 "")
       )
)
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-26 23:42 , Processed in 0.163433 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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