设为首页 |收藏本站 |帮助 |加入VIP |积分充值

QQ登录

只需一步，快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步，快速开始

返回
发新贴
展开

通知     

全站
8天前
查看: 1871|回复: 5
收起左侧

[求助] 请高手帮修改一个程序

[复制链接]
zedcar
发表于 2008-11-26 09:33:57 | 显示全部楼层 |阅读模式 来自： 中国湖北孝感

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要 登录 才可以下载或查看，没有帐号？注册

x
　　　在网上找的一个删除重复图元的ＬＩＳＰ程序　加载使用后发现对重复线段的删除有时候无效　而且线段内部的线段无法删除　就是说如果一条线段长１００一条长５０　使用这个删除不掉！！请高手帮忙修改下！！
" R0 w$ I) W% f6 @" e* [　以下是程序原文：（附件内容是程序源文件）4 k6 j; o- q  `& c* y' L+ ^6 K
(defun c:ere()
: g6 U, Z; X6 W2 `- p- Z  (setq m0 (getpoint "\n左下角："))
, v6 w" ?& F: `+ ?: q0 ~! ^  (setq m1 (getpoint "\n右上角："))
$ y' Z$ T: w6 G3 t$ D* n& U  (setq x0 (car m0) x1 (car m1) y0 (cadr m0) y1 (cadr m1) m2 m0 x2 x0 y2 y0)& w4 r  T) _# l$ J( I- ^9 F' X
  (while (< x2 x1)
* L1 Y' M1 p; J- Q9 {    (setq y2 y0 m3 m2)
; M9 d5 h# |6 P, O    (while (< y2 y1)9 `6 U8 w+ t) O) J2 v; w# Y- n
      (setq m4 (polar m3 0.785398 70.72))
) m5 n' q- V1 L% F/ V' x7 o      (setq a (ssget "_C" m3 m4))/ @2 W: r- c4 q: ^) \
      (if (not a)(setq i 0)(setq i (sslength a)))0 Q0 N1 o+ Y  w4 e$ a7 \) c& ~
      (while (> i 1)7 t( _, ]- v; Q
        (setq j (- i 1)): U. |1 m9 j  r# j2 L4 m3 j& E
        (setq b (ssname a (setq i (1- i)))) ;(setq b (ssname a 1))
" ~8 s; |; G' _6 `% P* Y        (setq c (entget b))9 X1 }" t; b4 X3 d0 n
        (setq d (cdr (assoc 0 c)))& r! y$ ?" S; C. I7 p
        (while (> j 0)
, a; n' y) Y+ v' A          (setq b1 (ssname a (setq j (1- j))))
- w5 A. _. D2 ^* ^/ b4 Q  t          (setq c1 (entget b1))5 }- b7 C, J- h: O
          (setq d1 (cdr (assoc 0 c1)))
5 m2 d( i' p5 D5 k          (if (= d d1)
" Z: o" R  U; ?5 `& i+ M            (if (= d "LINE")( e! x# a! Y! C9 d* j, k
              (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
8 v2 l" |3 ]  p                       (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))
- q5 [7 J2 ?2 j4 P7 O! W/ ^9 d                       (= (rtos (cadr (assoc 11 c)) 2 4)(rtos (cadr (assoc 11 c1)) 2 4))
4 d3 z) S3 ~4 |3 l                       (= (rtos (caddr (assoc 11 c)) 2 4)(rtos (caddr (assoc 11 c1)) 2 4))  V8 h% D+ }1 u
                  )(command "erase" b1 "")! ^  Z$ m' U! b+ q2 v
              )
: {/ v+ @" y7 g: ?3 Y) N+ T0 b              (if (= d "INSERT")( `6 x0 c& G& B9 b3 ]: \1 i8 e
                (if (and (equal (assoc 2 c) (assoc 2 c1))
8 i$ n% A9 t0 M( n9 n" x                         (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
7 N) v" h- L' H/ |9 E. j3 m                         (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))) H* S: t5 N4 `; \! A; B: k
                    )(command "erase" b1 "")
7 G" s1 K" h  N" R8 I                ); w: R4 E* z6 x
                (if (= d "LWPOLYLINE")& k( S: I- K0 H/ F4 c9 s* ^4 F! ]
                  (progn
- s* A: K, m( h8 `* {- D                    (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1))
0 z. r  ?5 s, d9 L                    (while (and e e1)
. A3 {$ c9 i- u1 G                      (progn 3 p( M- Q0 @" U* O% h
                      (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))
0 }2 [2 l7 h4 `9 ]5 w                      (while (and e (/= (car f) 10))(setq f (car e) e (cdr e)))6 s+ S4 j* n% p! P
                      (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1)))
5 j9 W1 E% C# p3 S9 K1 q! B                      (if (or (/= (rtos (cadr f) 2 4)(rtos (cadr f1) 2 4)): X" M) b* k5 m4 C" F( [  F3 @" R
                              (/= (rtos (caddr f) 2 4)(rtos (caddr f1) 2 4)))(setq e1 nil): P" b" W, x) o5 r
                        (if (not e1) (command "erase" b1 "")(if (not e)
4 W. z2 K( l7 w" r  }$ U                           (progn (command "erase" b "")(setq b b1 b1 nil))))
8 \7 z' [2 f( I                  ) ) ) )          - K, p. [# q1 z; W4 j
                  (if (= d "SPLINE")* L- [* D" V. m, G
                    (progn
' ~9 ^% S9 ^3 ]                      (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1))0 ]" S) J- N$ `% z
                      (while (and e e1)1 L  h" u  k, R9 [- ~. Y
                        (progn 7 P# V7 _4 _8 p8 i7 A
                          (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))
5 I/ }- a1 H/ q/ m# P( S, M" \                          (while (and e (/= (car f) 10))(setq f (car e) e (cdr e)))! }% f' {- N/ Q3 y' w" s& f
                          (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1)))3 l" |) E  G. t$ k3 S, t5 [  Q$ X
                          (if (or (/= (rtos (cadr f) 2 4)(rtos (cadr f1) 2 4))(/= (rtos (caddr f) 2 4)(rtos (caddr f1) 2 4)))(setq e1 nil)2 }+ ^1 O3 a) v/ l
                            (if (not e1 ) (command "erase" b1 "")(if (not e)(progn (command "erase" b "")(setq b b1 b1 nil))))/ M( C, q! K3 c& ^) `
                    ) ) ) )         
$ u( ^6 F7 J+ g9 s: ^; B                    (if (= d "TEXT")
6 e0 E% C9 A# I8 e) S                      (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))  S# H8 {1 E8 S# s  `
                               (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))- b7 S/ A$ o& r
                          )(command "erase" b1 "")
' f. `, }# z. K9 f                      )
) w( E2 w9 l! i2 D! X  W; a                      (if (= d "CIRCLE")  p( m4 W  ~' _2 u6 q- s
                        (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
6 C8 E; [0 K" s* Y                                 (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))" e1 B3 z/ f, O& J* Z+ a
                                 (= (rtos (cdr (assoc 40 c)) 2 4)(rtos (cdr (assoc 40 c1)) 2 4))
* L  m& [9 o0 P, m" [                            )(command "erase" b1 "")
; f! ]" q( Q. r2 l9 q      ) ) ) ) ) ) ) ) ) )
; Z+ x5 n' I3 C! y. j- Q& T      (setq m3 (polar m3 1.5708 50.0) y2 (+ y2 50.0))$ S) U1 q) O4 f" V& o
    )2 G: y5 F4 K; }
    (setq m2 (polar m2 0.0 50.0) x2 (+ x2 50.0))
: Z+ j8 m9 x+ c5 |. Y  )4 A) M9 ], Q: F5 s! ?
  (princ)
. L: z4 Q9 j$ @' D  k" U, n! ]) P)2 l4 {: {5 C7 m) y  d
(princ "\n\"ere\"启动")
# Y7 N& g  v1 d+ b" q& C3 x' ^- w6 h% f) ~7 C) E( C7 e5 P) f3 x2 R
[ 本帖最后由 zedcar 于 2008-11-26 09:35 编辑 ]

删除重复元素.rar

1.12 KB, 下载次数: 6
回复

举报

maoyangmy
发表于 2008-11-26 11:05:42 | 显示全部楼层 来自： 中国辽宁鞍山
有没有中间使用变量得说明？做什么用得？
回复 支持 反对

举报

zedcar
 楼主| 发表于 2008-11-26 12:40:25 | 显示全部楼层 来自： 中国湖北孝感
原帖由 maoyangmy 于 2008-11-26 11:05 发表 http://www.3dportal.cn/discuz/images/common/back.gif5 Y' Z" ?9 I4 c  s7 j0 p1 G
有没有中间使用变量得说明？做什么用得？
" S( Y+ Z# L1 ~" S) m" f- _: n+ ^
没有　这个程序用来删除多余的图元。程序特点，可以删除完全重合的直线、多段线、光滑曲线（程序中设置了4位小数，当坐标数值四舍五入精确到4位小数时认为重合），删除位置重合的文字，删除位置和半径相同的圆，删除位置和块名相同的块。
回复 支持 反对

举报

ljm68
发表于 2008-12-6 15:17:15 | 显示全部楼层 来自： 中国四川成都
给你一个思路：
2 M4 G: y: e) w! O    处理"LINE"时，增加一个判定函数，用于首先判定直线L1的两个端点是否在直线L2上面；若在，再判定直线L1的两个端点是否在直线L2的两个端点以内，则返回直线L1，否则返回直线L2。
% V. Y5 S5 d7 B( V2 R& d    判定直线L1的两个端点是否在直线L2上面：; d% m2 P' _% U1 M8 s
       可以逐点计算直线L1的两个端点到直线L2的距离是否小余你的精度要求，若小余，则判定为该点在直线L2上，否则，该点不在直线L2上。

评分

参与人数 1三维币 +5 收起 理由
woaishuijia + 5 技术讨论

查看全部评分

回复 支持 反对

举报

SunVei
发表于 2008-12-6 22:42:04 | 显示全部楼层 来自： 中国台湾
  1.    
    ( H) |3 E/ X' G8 _$ ~4 l
  2.     (defun dxg (code ele)
    1 w$ H- Q; l0 A; H7 _
  3.       (cdr (assoc code (entget ele)))
    ' b$ N' L9 O2 t8 y' i7 q
  4.     )
    & L5 C* N. B6 Z# o2 G' r4 N2 C
  5.        , V3 p6 P4 f* i; A: f8 v/ u+ G+ I
  6. ) N6 V- V: G, S
  7.     (defun vpt (a b c)
    , O; Y7 P+ X0 V4 f
  8.        (equal
    7 J; u" l3 B) e$ ^* I' |
  9.          (if (caddr a) a (reverse (cons 0.0 (reverse a))))3 K, Y) {# X' i8 I4 a* R& q+ b/ N/ L
  10.          (if (caddr b) b (reverse (cons 0.0 (reverse b))))( p$ Q; c+ o! b/ O  C
  11.          (expt 0.1 c)/ u  w) Y* G' L7 N3 d4 |& j& f- ?
  12.        )% n: n% E! ~9 \2 @
  13.     )
    ; t. i. m! g# j0 V' J
  14.     9 v; R/ u. z3 e, E3 L& u* \# g/ F
  15. ;;; =========== for Test only =========================================
    , i8 `, I* i- ~: ^
  16. ;;; 删除线段内的短线. l0 z* G* V% G
  17. ;; ssen = Line Selection. Q- c+ f8 Z! ~$ O8 w
  18. (setq nn (sslength ssen))
    6 i2 n8 l" Y# d+ M
  19. (cond- v& [6 r- T* \- ~  z
  20.   ((< nn 2) nil)                        ; Nothing to do0 D& V7 t; Z* ?2 V6 N1 q* m
  21.   (T' T+ n! e  E; @  ~
  22.    (princ "\nProceeding with Line ....."
    , @' M  w) k* l7 Q  t( J$ `
  23.    (while (setq ee (ssname ssen (setq nn (1- nn))))
    & t6 n+ Q, O  u5 t, k
  24.      (cond- U$ P, n1 ^# ~5 B& X
  25.        ((null (entget ee)))                ; bypass
    * P. M; N3 e7 Z: l# _9 U
  26.        (T
    * k- r; }  Z' E' N, [. b4 ?
  27.         (setq p1  (dxg 10 ee)9 v& E: n( z4 f: }+ L
  28.               p2  (dxg 11 ee)/ p9 Z9 X, ^  A) G. r7 u  x8 Y
  29.               v1  (angle p1 p2)
    . l( H( T- `4 a# v: Z1 [9 X" q
  30.               e1d (cdddr (cddr (entget ee)))
    : P8 `- a" |% r. e6 }8 S4 O8 _
  31.               sc  (ssget "f" (list p1 p2) '((0 . "LINE")
    + `% A1 \* I! E+ g2 I
  32.               sum (if sc (sslength sc)): c3 ?  o5 I4 |6 p  w: ~! M9 g
  33.         )
    + ~3 l8 W0 M" K+ ^. S' Z
  34.         (while (and (entget ee) (> sum 0))# Z# p$ S4 P2 q4 N! y
  35.           (setq e1 (ssname sc (setq sum (1- sum))))1 Y/ G& X7 k4 q$ N5 Y. R
  36.           (cond9 n! \: J+ E% i+ ^0 p2 c" ^
  37.             ((eq e1 ee) nil)                ; Itself1 o; F1 G) M; A) x
  38.             ((equal (cdddr (cdddr (entget e1))) e1d)3 U- R8 A! {4 O2 X) ~6 K
  39.              (entdel e1); q/ z- X1 q4 i5 U
  40.             )) |0 _5 [6 _# R' j
  41.             (T+ k" W9 E1 H, p, B8 o
  42.              (setq p3 (dxg 10 e1)
    9 Q4 e. `5 m/ t
  43.                    p4 (dxg 11 e1). Z* y) l/ d3 w6 C9 g
  44.                    v2 (if (vpt p1 p3 5); U3 a- J! S$ A' ~0 E! u
  45.                         (angle p2 p3)6 V. J2 M" `$ w
  46.                         (angle p1 p3)! O8 E1 T0 P  |, [, V$ {3 c# X
  47.                       )
    & {- u9 A* }3 O3 S5 \0 ]: i2 s( ^
  48.              )
    ! w/ f7 s3 f) g1 `9 i
  49.              (if (< (rem (abs (- v1 v2)) pi) 0.0001)  k. L8 c/ x" m8 k8 q
  50.                (if (< (distance p3 p4) (distance p1 p2))5 _- l, a& ]' L' ?1 M3 g
  51.                  (entdel e1)3 U' ^! ^) E/ x, R0 |9 p( k- q1 Z
  52.                  (entdel ee)/ I& ?8 O7 ?+ V' y
  53.                ), J7 O/ ?! w# w' a+ P+ m( t) z
  54.              )' G2 }# Z3 C4 n- w* S( C
  55.             )  a3 T* b6 Y; C6 O+ L6 F8 m
  56.           )( b- F) n/ S# d% V9 A5 t
  57.         )
    / [; J: i7 n# e8 g) k4 b7 S6 n+ [. {  Z
  58.        )/ n% i0 I* H  D/ R' R7 Q
  59.      )) C; g4 ~0 T1 S$ B/ ?
  60.    )9 J0 @( I/ L3 J- l
  61.   )
    8 L" e5 |! h2 l
  62. ); {9 o4 w8 B1 o4 G, k/ [+ H
  63. / s! L9 E, j1 t4 }8 c3 W, ]5 j  X4 V
复制代码
1 b6 J+ P2 Q* F4 r0 x
[ 本帖最后由 SunVei 于 2008-12-6 23:24 编辑 ]

评分

参与人数 1三维币 +10 收起 理由
woaishuijia + 10 应助

查看全部评分

回复 支持 反对

举报

cai813
发表于 2008-12-7 09:59:37 | 显示全部楼层 来自： 中国广东深圳
我认为对有利于促进论坛的发展,同时也激励会员多参与.但对于管理人员应该考虑工作需要,不收取流量.

评分

参与人数 1三维币 -50 收起 理由
woaishuijia -50 灌水

查看全部评分

回复 支持 反对

举报

发表回复
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则


Licensed Copyright © 2016-2020 http://www.3dportal.cn/ All Rights Reserved 京 ICP备13008828号

小黑屋|手机版|Archiver|三维网 ( 京ICP备2023026364号-1 )

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