QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

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

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

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

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

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

x
   在网上找的一个删除重复图元的LISP程序 加载使用后发现对重复线段的删除有时候无效 而且线段内部的线段无法删除 就是说如果一条线段长100一条长50 使用这个删除不掉!!请高手帮忙修改下!!5 u+ ?' P+ `& K' t; E  U3 W( u
 以下是程序原文:(附件内容是程序源文件); {& }! _: p, q6 @2 C& L2 S
(defun c:ere()
. P/ z: [  y+ T- U3 v" I  (setq m0 (getpoint "\n左下角:"))" [; x, H8 C  E  h" F! G" U5 F
  (setq m1 (getpoint "\n右上角:"))
* U/ P& n5 G8 C6 h2 T  (setq x0 (car m0) x1 (car m1) y0 (cadr m0) y1 (cadr m1) m2 m0 x2 x0 y2 y0)
6 C/ o/ \9 e- E4 V0 k, h7 s; y  (while (< x2 x1)
3 b/ R3 A$ y9 G    (setq y2 y0 m3 m2)/ Y/ a: a" @, u2 g/ A7 Q
    (while (< y2 y1)4 C1 ^8 x+ D9 Y8 m! x- O. b
      (setq m4 (polar m3 0.785398 70.72))
7 X3 m4 }- T8 i$ [      (setq a (ssget "_C" m3 m4))
) J& t" |) s4 x+ ^; Z1 f7 B+ I      (if (not a)(setq i 0)(setq i (sslength a)))
2 B% r& @) m) y/ z' y      (while (> i 1)& N  W5 y- V* S3 e0 R0 U1 j
        (setq j (- i 1))8 J2 x/ a* @. W' A: _
        (setq b (ssname a (setq i (1- i)))) ;(setq b (ssname a 1)), T5 O2 |  X0 G7 P9 [8 E+ W$ [
        (setq c (entget b))
2 w8 v7 L; j% \        (setq d (cdr (assoc 0 c)))) }6 K6 e6 _7 j
        (while (> j 0)
. q1 p* Y8 l4 g0 }0 ~          (setq b1 (ssname a (setq j (1- j))))
$ j1 t' g  u: w& W/ x; x3 m          (setq c1 (entget b1))
7 I) B% |$ O. s% E4 ?9 y8 o          (setq d1 (cdr (assoc 0 c1)))
/ g0 s$ Y8 T! F; f1 W0 G3 e          (if (= d d1)7 x' I9 E! ?  ~( f
            (if (= d "LINE")8 m8 T( w) N4 R, t: p8 }
              (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
# k* U7 Y5 I5 M. l                       (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))2 z6 P. k7 }+ X* N% g3 o
                       (= (rtos (cadr (assoc 11 c)) 2 4)(rtos (cadr (assoc 11 c1)) 2 4))2 O3 S6 t' L2 _% G0 a# }
                       (= (rtos (caddr (assoc 11 c)) 2 4)(rtos (caddr (assoc 11 c1)) 2 4))9 R/ o  a* |. d# R4 O6 {; Q
                  )(command "erase" b1 "")2 I7 e& Z/ E6 Q* i7 L
              )5 L& S6 X, u8 h! v$ r
              (if (= d "INSERT")' z5 W1 F. U+ [; W' e
                (if (and (equal (assoc 2 c) (assoc 2 c1))4 V0 W6 T" D: V- O/ i5 K9 y8 |
                         (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))) u: V8 P4 l6 r; c2 u
                         (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))
3 t* A7 @  d7 h* K: n7 n3 N                    )(command "erase" b1 "")2 y7 i* o; e5 d, j
                )
' Q/ G. C% ^. S8 N6 R8 A                (if (= d "LWPOLYLINE")
+ o; o, D2 K+ @, z( E+ g                  (progn) M( X  p& }" M8 G* D, `
                    (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1))9 e' y6 i. U: P  o5 ~4 t
                    (while (and e e1)
  M9 S- z+ Q: N3 E0 A- x8 \! _, a. L                      (progn
0 g7 x8 [3 {! [                      (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))  W2 W% u& U2 _. S/ r0 u$ F( R/ E
                      (while (and e (/= (car f) 10))(setq f (car e) e (cdr e)))
6 D" d: D7 q' v# J+ l+ L6 u% k                      (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1)))
( \4 |5 K4 R+ p4 B! f                      (if (or (/= (rtos (cadr f) 2 4)(rtos (cadr f1) 2 4))
$ s' [+ |# O; ~                              (/= (rtos (caddr f) 2 4)(rtos (caddr f1) 2 4)))(setq e1 nil)7 q, Y9 ?) s- M' y$ V8 w( z
                        (if (not e1) (command "erase" b1 "")(if (not e)
& H1 @( ^. \1 w4 C, i- i                           (progn (command "erase" b "")(setq b b1 b1 nil))))
" ^2 U6 ?$ ]- m+ u; U% i                  ) ) ) )         
9 _$ g3 M& o+ i& N( d                  (if (= d "SPLINE")7 G8 ~% I1 ?& d6 T5 p
                    (progn8 A5 o# M  N- ^) J( P3 S7 H; _. t
                      (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1))
, s: {3 I/ T& d! r6 L0 Y0 _/ d                      (while (and e e1)
- f2 u5 T* j7 Q- F                        (progn % t  ?% |- t" C9 U, N' u6 S
                          (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))/ {0 `, ], C( B  S" o
                          (while (and e (/= (car f) 10))(setq f (car e) e (cdr e))): s7 |% z0 T( P! w- M
                          (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1)))
, `. A6 C0 \+ S- _; a( J6 E                          (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)1 a) t, y" E; Q$ B2 _8 N4 G6 n* z
                            (if (not e1 ) (command "erase" b1 "")(if (not e)(progn (command "erase" b "")(setq b b1 b1 nil))))! f) B' S- \. t$ I& h1 l0 \) u( `
                    ) ) ) )         
# T+ i7 E" G. U  j, P8 i                    (if (= d "TEXT")1 |. E% h& \) [/ K6 l. T. a; g
                      (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
% m; M* P1 G: E9 n                               (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))
. {8 P. a, S" Z; z& g                          )(command "erase" b1 "")
( Y" @3 v5 I" d5 N                      ); i. L5 F% V# K1 `4 @2 m
                      (if (= d "CIRCLE")
6 e" b' K; ^5 J4 X                        (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
6 l; }4 }9 U  c$ ^                                 (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4)): b$ q/ P0 f3 v% I% s
                                 (= (rtos (cdr (assoc 40 c)) 2 4)(rtos (cdr (assoc 40 c1)) 2 4))8 `, Z" t9 s& J
                            )(command "erase" b1 "")
( H5 Z0 D$ Z  a) g* e      ) ) ) ) ) ) ) ) ) )" b5 P, D4 a" c
      (setq m3 (polar m3 1.5708 50.0) y2 (+ y2 50.0))3 v( f/ g: s' [7 x' S: D6 [! b% k+ L
    )$ k* t" ]$ q7 U) K! v$ S
    (setq m2 (polar m2 0.0 50.0) x2 (+ x2 50.0))
0 n, u/ |, L7 r# A1 B6 [( A  )
- u5 Z" h+ o4 T+ |2 s  O+ x3 ]4 B, w  (princ)9 }- o( H- k7 i, n7 c
)8 K" @: d# Z4 H9 x
(princ "\n\"ere\"启动")) y3 Q0 ]7 ]! A3 }

& W  |2 N- i& T8 D; d[ 本帖最后由 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% {( a# z* Y; D. N/ i
有没有中间使用变量得说明?做什么用得?
% y/ ?. s/ q; b6 I! x; K% d
没有 这个程序用来删除多余的图元。程序特点,可以删除完全重合的直线、多段线、光滑曲线(程序中设置了4位小数,当坐标数值四舍五入精确到4位小数时认为重合),删除位置重合的文字,删除位置和半径相同的圆,删除位置和块名相同的块。
发表于 2008-12-6 15:17:15 | 显示全部楼层 来自: 中国四川成都
给你一个思路:
* o* Y  I$ X# W    处理"LINE"时,增加一个判定函数,用于首先判定直线L1的两个端点是否在直线L2上面;若在,再判定直线L1的两个端点是否在直线L2的两个端点以内,则返回直线L1,否则返回直线L2。0 b; X, c) q! t/ i1 a/ u& L
    判定直线L1的两个端点是否在直线L2上面:
  d% A4 s+ R0 H! R) _7 Q       可以逐点计算直线L1的两个端点到直线L2的距离是否小余你的精度要求,若小余,则判定为该点在直线L2上,否则,该点不在直线L2上。

评分

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

查看全部评分

发表于 2008-12-6 22:42:04 | 显示全部楼层 来自: 中国台湾
  1.    
    : e/ s$ n, ~7 q9 @
  2.     (defun dxg (code ele)
    1 P- T+ Q, Z$ T# S8 ?# Z% ~* j2 b' \
  3.       (cdr (assoc code (entget ele)))
    : Q+ u% [% q: a2 B
  4.     )
    4 h2 q5 t; l' R' |: s8 V1 U
  5.       
    - h( I# Q4 ^0 G8 r: E8 x

  6. $ G0 [7 \2 Z7 x* o
  7.     (defun vpt (a b c)
    # q0 l2 J( u# K- S  c
  8.        (equal
    * H; K- P1 p% v% b8 h
  9.          (if (caddr a) a (reverse (cons 0.0 (reverse a))))
    " E" Y& C. C& ^; L4 Q1 D1 |
  10.          (if (caddr b) b (reverse (cons 0.0 (reverse b)))); L7 q, X# T3 N: ^( c6 X8 @6 R% s4 e
  11.          (expt 0.1 c)
    - D: R- _5 w" [( O
  12.        )
    $ ]( u: b& r$ @: x
  13.     )+ `2 j* n5 `9 c, Q9 v; T% V
  14.    
    & P' w% M* ]* M0 l
  15. ;;; =========== for Test only =========================================5 j0 Y2 _! g- T7 r$ \3 v
  16. ;;; 删除线段内的短线
    $ _" h. J0 j( A0 Q  Q/ \; c- a
  17. ;; ssen = Line Selection
    % y4 j( j) q  M  V1 O
  18. (setq nn (sslength ssen))
    ( D( y" E% j# i9 B
  19. (cond
    - C, b. ~# F4 U' w
  20.   ((< nn 2) nil)                        ; Nothing to do
    ; |+ ^' W+ C6 q/ P$ |
  21.   (T7 @/ c' l2 B8 r7 K! y
  22.    (princ "\nProceeding with Line ....."- y# _5 q* M' Z% h7 m- l
  23.    (while (setq ee (ssname ssen (setq nn (1- nn))))
    ' u5 Y" g, W3 N9 X/ Q: u( j0 A" n
  24.      (cond
    1 N! N0 R) r1 }, V0 ~1 l! o6 i
  25.        ((null (entget ee)))                ; bypass# M2 h& T+ x3 g$ e3 A
  26.        (T
    . z+ k+ u" P3 y' f, C) y
  27.         (setq p1  (dxg 10 ee)* t" A3 g; C6 m+ V$ i
  28.               p2  (dxg 11 ee)" F% i* o0 w! B% X
  29.               v1  (angle p1 p2)
    5 Q- d% M" K9 G) i  Q
  30.               e1d (cdddr (cddr (entget ee)))
    . g, o' \4 X2 `6 _' x* g; f& W
  31.               sc  (ssget "f" (list p1 p2) '((0 . "LINE")) Z0 K+ p* E, i8 p% o; \1 [
  32.               sum (if sc (sslength sc))5 W" c- h. b6 f3 v5 C# H, K% ^: ]
  33.         )) G  U% _' G" J. ^4 C0 m6 o9 e
  34.         (while (and (entget ee) (> sum 0))
    % |& G' }, v6 F
  35.           (setq e1 (ssname sc (setq sum (1- sum))))& z" l  H+ i7 R$ a3 d# R7 ^
  36.           (cond
    ; }! [  D4 ^) a- t8 |  I6 x! G
  37.             ((eq e1 ee) nil)                ; Itself
    4 k; V" d- [. l! S
  38.             ((equal (cdddr (cdddr (entget e1))) e1d)" A  \$ s& |* M- ]% D! ]( |
  39.              (entdel e1)
    6 W8 Z! L: t  l" `: k: }
  40.             )
    " i9 s. V# T# [+ E' s! I
  41.             (T! C) G! k, u- m! V
  42.              (setq p3 (dxg 10 e1)7 F  M6 D5 G" i: z+ x
  43.                    p4 (dxg 11 e1)
    " j  Q* o8 n6 d# e
  44.                    v2 (if (vpt p1 p3 5)  [* r( z$ g4 H: B9 A$ H
  45.                         (angle p2 p3)* ^) l  L7 n  D. c3 N" S3 D( D
  46.                         (angle p1 p3)
    + q  k! E% G4 ?8 Q. s5 U; ?) n
  47.                       ). v" j  N2 i* Q  i
  48.              )
    $ [/ ^3 L9 \  H8 x' ^
  49.              (if (< (rem (abs (- v1 v2)) pi) 0.0001)' @1 G$ L6 E2 J4 Z
  50.                (if (< (distance p3 p4) (distance p1 p2))5 O0 ^- N' g: f' Q& C1 q
  51.                  (entdel e1)
    7 [- e8 q+ \& j+ X# D/ t4 e
  52.                  (entdel ee)
    8 T1 K$ \2 S$ B& `% g8 j  T
  53.                )$ s( ?) O! A2 u
  54.              )* Y+ \( w1 W$ {( ]
  55.             )& x5 V3 {% u! R7 \
  56.           )
    . W' o- f4 L: z2 z4 E5 _& d
  57.         )  X# o# ~0 ^( t$ `
  58.        )8 u* d  |5 q- x
  59.      )5 ^  u0 u; a: g6 D+ C
  60.    )
    " v$ o8 ^6 N( Q! N. n
  61.   )
      P) [$ P) [; J# M2 }8 ?. j
  62. )9 W4 `; O; p7 o1 @( e+ Y; w+ z) Y

  63. - d6 \, r1 A" |2 e( A1 }( f
复制代码

/ `6 ]1 k8 i5 f" ]0 |" N! \" M[ 本帖最后由 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 )

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