QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

查看: 1885|回复: 5
收起左侧

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

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

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

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

x
   在网上找的一个删除重复图元的LISP程序 加载使用后发现对重复线段的删除有时候无效 而且线段内部的线段无法删除 就是说如果一条线段长100一条长50 使用这个删除不掉!!请高手帮忙修改下!!: ]% d' \3 C' k, V' F. \$ G
 以下是程序原文:(附件内容是程序源文件). A* b; Z; |1 |* _3 e5 k
(defun c:ere()
0 F+ [# \5 o8 e  w6 D+ U  (setq m0 (getpoint "\n左下角:"))
! o8 r" I- k2 M& j  j  (setq m1 (getpoint "\n右上角:"))
  z: J! j$ z3 A" U5 J  (setq x0 (car m0) x1 (car m1) y0 (cadr m0) y1 (cadr m1) m2 m0 x2 x0 y2 y0)
( K8 P. q( l6 y5 v" E0 I; P  (while (< x2 x1)" A. ^4 N1 g) ]' K, X4 t2 C
    (setq y2 y0 m3 m2)
+ {( s3 a& P  ]; J) M" @    (while (< y2 y1)
1 X$ M: Z4 O) y/ a* T+ q$ F      (setq m4 (polar m3 0.785398 70.72))& i+ l4 `6 j. a2 \. p
      (setq a (ssget "_C" m3 m4))
; W% b& F2 u& _9 O# {' G" b      (if (not a)(setq i 0)(setq i (sslength a)))
# u9 h' P, [4 V7 n( e      (while (> i 1)& h; Z1 U) z1 `% f4 p
        (setq j (- i 1))
0 H8 a1 D9 R( F3 E8 E1 w+ X* m' J" p        (setq b (ssname a (setq i (1- i)))) ;(setq b (ssname a 1))
7 _+ d( H7 r, e# Y7 k2 \* }        (setq c (entget b))- U% @! m* `* l' V! k8 b7 Z
        (setq d (cdr (assoc 0 c)))
$ e8 n2 H- v) I. z& l/ J( N/ h        (while (> j 0)
) H8 i: g' d  i1 ^7 Y          (setq b1 (ssname a (setq j (1- j))))8 @  q# G" K( _( T# Z4 n5 A  z) C. A
          (setq c1 (entget b1))
. q  k9 [* c: h# y8 X1 p* h' `1 h9 _          (setq d1 (cdr (assoc 0 c1)))2 c& ?/ \8 H+ b5 E3 B
          (if (= d d1)
( \8 N* R% L" e1 ]0 x: x            (if (= d "LINE")& u' Q' u, I- G
              (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))3 Q9 O+ a; B  D5 ?) j  B4 Y' l
                       (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))
6 e2 z( k; e, S                       (= (rtos (cadr (assoc 11 c)) 2 4)(rtos (cadr (assoc 11 c1)) 2 4))
- R; V2 O9 e% R+ G* w8 r7 E5 Q4 s3 d                       (= (rtos (caddr (assoc 11 c)) 2 4)(rtos (caddr (assoc 11 c1)) 2 4))
0 f5 O" B. |7 {" g; M7 P) U                  )(command "erase" b1 "")
( t  W* L/ z. {6 `6 v% J; s% _              )
! j& R% z! a/ L- {, E              (if (= d "INSERT")- n3 \4 v# I& G( A/ `7 D
                (if (and (equal (assoc 2 c) (assoc 2 c1))
1 g* N. g! M3 V                         (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
4 [- t% \, y3 P                         (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))0 F8 X! u' {3 Q3 ~3 F# _( d& j4 A
                    )(command "erase" b1 "")$ ]7 q9 _/ F( U+ D7 L- M  b" J+ \: O
                )' U. I+ A% Y/ p8 R
                (if (= d "LWPOLYLINE")+ G3 r2 c4 v1 y2 h$ S
                  (progn2 f' I2 a+ H4 Q0 r5 F
                    (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1))' G! S2 f) g+ f% d* \; t/ a( I
                    (while (and e e1)2 L9 K  `% t1 t0 o1 V) ^- h$ M7 H+ \
                      (progn
+ @4 V. A# V  j2 B                      (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))+ u. Y3 N# P5 N  y( H3 {( i
                      (while (and e (/= (car f) 10))(setq f (car e) e (cdr e)))$ C+ m1 s& G  }
                      (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1)))
8 D/ w8 y3 J. q! e# f( J0 l5 X                      (if (or (/= (rtos (cadr f) 2 4)(rtos (cadr f1) 2 4))5 E$ B2 d' W2 V& m
                              (/= (rtos (caddr f) 2 4)(rtos (caddr f1) 2 4)))(setq e1 nil), ^' U; ]2 o; V7 p5 d( r1 M! y% G
                        (if (not e1) (command "erase" b1 "")(if (not e)
  ~# h7 O+ @  w1 S6 t& A7 E, ]$ F                           (progn (command "erase" b "")(setq b b1 b1 nil))))7 T, Q% }8 l1 j& s. W9 z8 w
                  ) ) ) )         
0 O9 b. ?& J& x* y/ z  K1 e1 s: \                  (if (= d "SPLINE")# y) }" U9 D1 O1 T( G) c, r  t
                    (progn
% y$ V: ]" Y# d8 {                      (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1))! s0 t: n, G9 I8 a6 |
                      (while (and e e1)
, }( @# \; t+ [  ?                        (progn 7 ^2 K- i6 z2 {9 a7 G7 z
                          (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))
, T- Z# m- N. a# Y. j, T                          (while (and e (/= (car f) 10))(setq f (car e) e (cdr e)))/ d9 z4 [" O- X2 D+ ~; q6 t
                          (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1)))6 o7 L' V# t/ F2 m% W! B
                          (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)
" x1 S6 o$ f9 h$ g% L' q- H                            (if (not e1 ) (command "erase" b1 "")(if (not e)(progn (command "erase" b "")(setq b b1 b1 nil)))); o$ @4 u( ?0 O. i6 Q- {. l: r+ ~
                    ) ) ) )         
% j* q% I. d  ^1 s1 s                    (if (= d "TEXT")( y6 R5 Y& p, i0 A( i$ d
                      (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))1 [- d+ g& b) A' d. a/ r
                               (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))
  g, ^& o: X  D# T6 C                          )(command "erase" b1 ""): S2 V) @6 E+ e. K3 `0 w
                      )
6 n8 T8 R4 l3 L5 J& _/ p# V                      (if (= d "CIRCLE")) c7 R. C' A0 ^; M
                        (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))6 I: r# y! j1 M! I7 Y3 R
                                 (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))1 w8 c5 t) L' g/ b& K9 |- U
                                 (= (rtos (cdr (assoc 40 c)) 2 4)(rtos (cdr (assoc 40 c1)) 2 4))1 U/ ^8 u" P7 Z% B- G
                            )(command "erase" b1 "")4 A* v# o3 ^: W
      ) ) ) ) ) ) ) ) ) )5 x0 a, W3 m; R: }: z
      (setq m3 (polar m3 1.5708 50.0) y2 (+ y2 50.0))
$ c, J# m- K# t& ^) d+ A    )  t3 z) i# c  N8 D! O9 Z
    (setq m2 (polar m2 0.0 50.0) x2 (+ x2 50.0))
1 N) ]' o3 `, D* R& B  )
3 ]; ~; s* L* ?7 ?/ x+ R# k, [5 e8 O  (princ)
' n- u$ h$ X4 Z* u; d)
( ^- O# K( c* w& X4 O! O; T" r; l(princ "\n\"ere\"启动")9 [$ ^( N, m) z+ D

; D% ^  Z  P: i6 @# ?8 A[ 本帖最后由 zedcar 于 2008-11-26 09:35 编辑 ]

删除重复元素.rar

1.12 KB, 下载次数: 6

发表于 2008-11-26 11:05:42 | 显示全部楼层 来自: 中国辽宁鞍山
有没有中间使用变量得说明?做什么用得?
 楼主| 发表于 2008-11-26 12:40:25 | 显示全部楼层 来自: 中国湖北孝感
原帖由 maoyangmy 于 2008-11-26 11:05 发表 http://www.3dportal.cn/discuz/images/common/back.gif
$ N- P1 d9 Z" {; Y+ ?( d5 c6 M有没有中间使用变量得说明?做什么用得?
. O& I1 h# q" _
没有 这个程序用来删除多余的图元。程序特点,可以删除完全重合的直线、多段线、光滑曲线(程序中设置了4位小数,当坐标数值四舍五入精确到4位小数时认为重合),删除位置重合的文字,删除位置和半径相同的圆,删除位置和块名相同的块。
发表于 2008-12-6 15:17:15 | 显示全部楼层 来自: 中国四川成都
给你一个思路:
# X& A) _" Q$ w( g+ M4 `  i+ N    处理"LINE"时,增加一个判定函数,用于首先判定直线L1的两个端点是否在直线L2上面;若在,再判定直线L1的两个端点是否在直线L2的两个端点以内,则返回直线L1,否则返回直线L2。+ o; h& b% ^0 y* F; t
    判定直线L1的两个端点是否在直线L2上面:" v( s5 }2 X2 `1 I8 @5 D' I, ]' ?
       可以逐点计算直线L1的两个端点到直线L2的距离是否小余你的精度要求,若小余,则判定为该点在直线L2上,否则,该点不在直线L2上。

评分

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

查看全部评分

发表于 2008-12-6 22:42:04 | 显示全部楼层 来自: 中国台湾
  1.    
    6 k( X9 `* }3 h' k. R5 K8 r0 }
  2.     (defun dxg (code ele)' U' \! ]$ c* x4 V* O
  3.       (cdr (assoc code (entget ele)))
    6 x; d7 n1 j, I3 v
  4.     )( ~7 _" i* \) U" V2 i0 Y5 t' e
  5.       
    , j, F6 Y: ~. m- m
  6. 3 B+ }! ]( z0 H4 u
  7.     (defun vpt (a b c)3 d+ r+ Y/ j" e1 A, W, j) c; c
  8.        (equal
    ( Q+ N( H) l7 ]3 F% i- M# }
  9.          (if (caddr a) a (reverse (cons 0.0 (reverse a)))). k* Y* ?/ i2 r6 v3 {& P
  10.          (if (caddr b) b (reverse (cons 0.0 (reverse b))))1 Q' L+ f# o/ n( S
  11.          (expt 0.1 c)8 Y5 G4 X0 H2 k4 r& U- f
  12.        ): K. Z1 `5 z# N+ F0 h# k
  13.     )8 F  V9 C' c. g9 r2 u4 [1 g* G! I# o
  14.    
    6 W; }' m0 i" G! Q; K# T7 a
  15. ;;; =========== for Test only =========================================
      m( g* n" A* N0 @: l
  16. ;;; 删除线段内的短线$ O: p( Z2 L& u! X& j2 e
  17. ;; ssen = Line Selection
    + t7 u5 e/ p& s- v& s
  18. (setq nn (sslength ssen))6 g$ Z- n* L" j3 A3 V' O
  19. (cond" }- u. @0 T9 `% I- v% O
  20.   ((< nn 2) nil)                        ; Nothing to do6 O' p0 z/ f. @! H
  21.   (T
    8 t  S& ^4 O3 p6 I/ M/ y
  22.    (princ "\nProceeding with Line ....."
    8 p* Z3 T6 O* u! o2 H& y0 ^
  23.    (while (setq ee (ssname ssen (setq nn (1- nn)))) 9 M' F# Y6 u8 K+ ~) {) S* N* b
  24.      (cond
    ( ^  |+ u4 ?1 Q
  25.        ((null (entget ee)))                ; bypass7 X! Y: d7 v8 ]4 p! L# y
  26.        (T) d: i6 }0 E6 g$ ?; ~/ D
  27.         (setq p1  (dxg 10 ee)
    ' Z; {. W0 O) Y/ a$ P" H
  28.               p2  (dxg 11 ee)3 Q9 s' [+ R1 D- I
  29.               v1  (angle p1 p2)& [  ?) H- A% G9 s) C$ L
  30.               e1d (cdddr (cddr (entget ee)))
    & C* F6 J4 }5 V, j( U5 b$ b
  31.               sc  (ssget "f" (list p1 p2) '((0 . "LINE")0 E. R* w' |7 }+ ?, H1 ?. e# t
  32.               sum (if sc (sslength sc)); K4 _5 M2 P# l) C( W, k) h9 J
  33.         )
    # y8 h1 n( |5 m/ P6 o9 e$ H" g+ @
  34.         (while (and (entget ee) (> sum 0))
    5 T( h. m! u( ]
  35.           (setq e1 (ssname sc (setq sum (1- sum))))
    6 y, C( P/ s7 |3 A! V% d1 ]$ C
  36.           (cond
    5 J& K/ S( t$ U+ N0 K$ |# I, C
  37.             ((eq e1 ee) nil)                ; Itself# Y) i' k9 J7 r: M5 q" P
  38.             ((equal (cdddr (cdddr (entget e1))) e1d), ], Y8 N8 H+ }2 z; t6 I
  39.              (entdel e1)
    * ?% p- [7 e0 ~9 T& l6 S+ E' F
  40.             )
      q4 k  ~4 S* U; h, C* B6 f
  41.             (T
    6 r/ Z5 }- u5 W9 k: }+ d
  42.              (setq p3 (dxg 10 e1)9 d( t* h. K' q7 h& ^- \9 P* N$ L
  43.                    p4 (dxg 11 e1)
    5 y* q, d3 p9 a" |9 F( H( a
  44.                    v2 (if (vpt p1 p3 5)3 ?: [4 @) n, T# W- @& W" O
  45.                         (angle p2 p3)
    & O  x; U7 l4 V+ E  I% }
  46.                         (angle p1 p3)
    ) u- N8 S& {7 K0 _1 {8 _1 Z
  47.                       )+ t7 o: [/ q" S2 S% a. Z  c
  48.              )
    9 z; n) O  K+ |0 r
  49.              (if (< (rem (abs (- v1 v2)) pi) 0.0001)
    " \+ W. G& |( r$ e" O
  50.                (if (< (distance p3 p4) (distance p1 p2))7 ^% ^0 Z1 v* Z* h9 x) y
  51.                  (entdel e1)
    5 o& n; Z  y( j$ k
  52.                  (entdel ee)
    $ G3 f8 M9 c4 w% Q; u* H
  53.                )
    3 Q$ S* B$ u' K) f
  54.              )
      Z4 S2 J8 s* X* p: \$ N7 M
  55.             )
    % A5 x, Z& z0 V- k1 U* O
  56.           )' w1 d5 [% A7 p& Y
  57.         )
    2 ^, h! M) h: `: w: T' v- w
  58.        )* ~: b" ^  V& n$ `0 K
  59.      )) @6 d: H2 ^6 C4 h9 u* b& h/ h3 ]
  60.    )
    * ?# v# v3 T! q* e  Y6 w. E# U
  61.   )& M; x, C1 O% I2 C; ^. n4 g
  62. )% }# Q6 E" J" Q2 l
  63. # E% ?/ [, d0 x& h. ]
复制代码
% s7 q+ u) N; t" o+ }. `; S
[ 本帖最后由 SunVei 于 2008-12-6 23:24 编辑 ]

评分

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

查看全部评分

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

评分

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

查看全部评分

发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则


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

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

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