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

QQ登录

只需一步，快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步，快速开始

返回
发新贴
展开

通知     

全站
10天前
查看: 1872|回复: 5
收起左侧

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

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

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

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

x
　　　在网上找的一个删除重复图元的ＬＩＳＰ程序　加载使用后发现对重复线段的删除有时候无效　而且线段内部的线段无法删除　就是说如果一条线段长１００一条长５０　使用这个删除不掉！！请高手帮忙修改下！！( g* s5 L/ v* l
　以下是程序原文：（附件内容是程序源文件）4 ~/ A( v' M3 o. F1 s( j
(defun c:ere(). O) Y/ _& F5 U. U# V! R; }
  (setq m0 (getpoint "\n左下角："))
" h/ `# h* N. U7 h" ]  (setq m1 (getpoint "\n右上角："))2 H% V5 S) r+ G0 x. z6 w* Y# ]( V
  (setq x0 (car m0) x1 (car m1) y0 (cadr m0) y1 (cadr m1) m2 m0 x2 x0 y2 y0)
" j' N. f& f$ R; M- b/ P% L9 F  (while (< x2 x1)" R# I. T8 Z( A' k
    (setq y2 y0 m3 m2): l2 z% o2 O/ Q- d; F
    (while (< y2 y1)
: r4 h6 l7 H" n* t, ~1 d2 S& [  n! h      (setq m4 (polar m3 0.785398 70.72))+ `0 N3 g1 t# @$ q
      (setq a (ssget "_C" m3 m4))- S7 x: c8 M$ h# B" O, W7 y7 k3 k
      (if (not a)(setq i 0)(setq i (sslength a)))
/ u# _* b! x: Q2 R1 V! ~      (while (> i 1)% B4 X- Y" o4 r, ?7 k6 m
        (setq j (- i 1))
0 s* \9 w9 ?& t, b2 s" M        (setq b (ssname a (setq i (1- i)))) ;(setq b (ssname a 1))9 n; ]9 r7 c6 p& l- N5 I
        (setq c (entget b))
( q6 i$ w7 E$ e2 W* K; }" D        (setq d (cdr (assoc 0 c)))
* i# l5 \" B7 W0 }4 A        (while (> j 0)
% m% t& \0 c/ h1 a: X! V) X          (setq b1 (ssname a (setq j (1- j))))
3 d# |/ E' T" _3 t  v          (setq c1 (entget b1))$ E& G3 ?* W* ~6 K+ F
          (setq d1 (cdr (assoc 0 c1)))
) W3 p7 i; F7 M7 y8 I& N% b  d          (if (= d d1)  T# L: L+ `3 D' @2 T
            (if (= d "LINE")
" k2 w( k, L  W              (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))+ \/ K0 N9 l) ], M& B) _  r
                       (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))
$ d. t) S" a) B: L! L! F2 G# v                       (= (rtos (cadr (assoc 11 c)) 2 4)(rtos (cadr (assoc 11 c1)) 2 4))
5 S7 u, _" i; z* d% ~                       (= (rtos (caddr (assoc 11 c)) 2 4)(rtos (caddr (assoc 11 c1)) 2 4))
  F, {9 D) k, p: ]5 _# {                  )(command "erase" b1 "")! c$ s3 M4 |/ Z  E
              )
0 x3 L5 t$ p2 b2 Y              (if (= d "INSERT")
1 l8 S4 Z4 s( @5 D$ [3 |                (if (and (equal (assoc 2 c) (assoc 2 c1))' }' v  J8 e3 u+ u1 b  [% i. P
                         (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))+ p( C) T8 }0 ]% l6 P" _
                         (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))5 [3 ~4 Y% @8 f+ T
                    )(command "erase" b1 "")
! z& R$ b7 C1 g1 W                )
9 z% u# [+ h% [% `7 e7 C) F                (if (= d "LWPOLYLINE")
0 N2 N7 [. g& W. ]8 X; y( p; ^                  (progn, z1 y8 {5 d, _- D  `, P
                    (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1)); @% I8 n' Q; a  S# C
                    (while (and e e1)
; Z" u& k, h1 t. x" t                      (progn
1 F1 K# [, W: n+ V5 x' l                      (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))
/ i* q5 ~& i' }' R) M7 k                      (while (and e (/= (car f) 10))(setq f (car e) e (cdr e)))3 I& V( B$ N+ f$ ~
                      (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1)))9 W: f' A6 _2 U7 V8 v
                      (if (or (/= (rtos (cadr f) 2 4)(rtos (cadr f1) 2 4))  @* d) b; I$ r& m4 E- M0 l
                              (/= (rtos (caddr f) 2 4)(rtos (caddr f1) 2 4)))(setq e1 nil)
5 v( g" q& x3 w, s( c                        (if (not e1) (command "erase" b1 "")(if (not e)
/ C7 k# w5 c. G% I! h9 l1 F) T' D                           (progn (command "erase" b "")(setq b b1 b1 nil))))" y: N, ^  W: a4 z  r. _# ?% [& F
                  ) ) ) )          ; ^: ?/ a0 q/ {1 q' P
                  (if (= d "SPLINE")" B6 U2 K# F5 _: s" \
                    (progn, Z% Y2 A5 o4 {- X* m- D  ]$ ]
                      (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1))
4 X% Y5 A  ~  Q7 D* a                      (while (and e e1)
7 H1 `3 A/ a+ K8 T) z) v: Y; K+ c% ^                        (progn % z" _. d& o5 c) e$ E! p) v. _
                          (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))# \6 S2 ?& C. e0 z/ {% e
                          (while (and e (/= (car f) 10))(setq f (car e) e (cdr e)))9 x2 e+ V  m9 U# n6 S2 F
                          (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1)))% n* K& ?9 h5 z4 R
                          (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)* T3 E3 n& S0 {0 I! O& B& n7 D0 w7 q9 Q& O
                            (if (not e1 ) (command "erase" b1 "")(if (not e)(progn (command "erase" b "")(setq b b1 b1 nil))))
  g# p: U1 i2 D: W% B) T9 B                    ) ) ) )          6 _4 I$ {/ n7 d8 O1 {1 u. z
                    (if (= d "TEXT")
. o3 B" S0 O/ E1 x                      (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))( _" K8 Z0 l$ R. }* u
                               (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))( [2 P2 S9 j0 \3 n5 s6 W: {
                          )(command "erase" b1 "")+ `0 K+ }: c' i' B" v  U
                      )
: u" z2 S4 B4 b2 \3 P( f! B! \                      (if (= d "CIRCLE")
$ X. H$ B: @% k. I6 C5 p  P" E2 o                        (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
+ j( S& z" @$ u7 f1 F                                 (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))
7 T" d; O7 \/ ?# d! d% n! Z                                 (= (rtos (cdr (assoc 40 c)) 2 4)(rtos (cdr (assoc 40 c1)) 2 4))
& |1 |; N3 e. I- [0 y                            )(command "erase" b1 "")
# e% n- H% }! K! T7 C) N( m: E# ]: p      ) ) ) ) ) ) ) ) ) )
8 n1 }$ ]" ^4 x$ y6 }9 I1 ?. R      (setq m3 (polar m3 1.5708 50.0) y2 (+ y2 50.0))' f! n) I) T- C. m
    )
1 U+ k, K. W/ b) H- O    (setq m2 (polar m2 0.0 50.0) x2 (+ x2 50.0))
. \2 V7 {, J; t  )0 Z! ~5 H$ a9 H# ~1 }! ]- L
  (princ)$ S: K7 U9 Z( ^, ~* [- w* ^
)
# _' D; o2 U. N7 a  h1 Z, `(princ "\n\"ere\"启动")
3 b' e0 l  t2 T
& _/ c6 K( o! v& ]; c+ }  g[ 本帖最后由 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.gif
3 H9 E4 M* \' E0 |  m  W' u有没有中间使用变量得说明？做什么用得？
) q# I# p7 H; r1 V
没有　这个程序用来删除多余的图元。程序特点，可以删除完全重合的直线、多段线、光滑曲线（程序中设置了4位小数，当坐标数值四舍五入精确到4位小数时认为重合），删除位置重合的文字，删除位置和半径相同的圆，删除位置和块名相同的块。
回复 支持 反对

举报

ljm68
发表于 2008-12-6 15:17:15 | 显示全部楼层 来自： 中国四川成都
给你一个思路：/ \' }  t+ b) E6 w# e; ^
    处理"LINE"时，增加一个判定函数，用于首先判定直线L1的两个端点是否在直线L2上面；若在，再判定直线L1的两个端点是否在直线L2的两个端点以内，则返回直线L1，否则返回直线L2。' \" z2 t" t) q) ?  M9 x
    判定直线L1的两个端点是否在直线L2上面：% G8 S- ^  f2 {0 }+ j8 m1 ^
       可以逐点计算直线L1的两个端点到直线L2的距离是否小余你的精度要求，若小余，则判定为该点在直线L2上，否则，该点不在直线L2上。

评分

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

查看全部评分

回复 支持 反对

举报

SunVei
发表于 2008-12-6 22:42:04 | 显示全部楼层 来自： 中国台湾
  1.    
    9 o5 L) j7 B' T2 s
  2.     (defun dxg (code ele)
    6 g; f* a' R9 Q; I" Q, F$ D
  3.       (cdr (assoc code (entget ele)))6 Y4 z# \) @2 x. m
  4.     )
    2 c! p& ^  h& f4 E' R
  5.       
    0 |- R# h. ?# V6 v& h
  6. 1 Q2 a6 V4 }0 I
  7.     (defun vpt (a b c)
    8 T  e: W5 G& m. p) j4 e
  8.        (equal
    0 l5 @( L' ]* \' `5 n3 b
  9.          (if (caddr a) a (reverse (cons 0.0 (reverse a))))
    ( |" l5 T3 j4 O
  10.          (if (caddr b) b (reverse (cons 0.0 (reverse b))))
    , o6 \) O( ?) C6 K7 @" W
  11.          (expt 0.1 c)
    1 r5 o- S) c. ]0 y: T
  12.        )+ v) q8 I; s4 x) y! x9 h; N. T! v- _/ |
  13.     )
    1 A2 T, K0 w2 T
  14.     * O6 E6 J3 v- t: L7 K9 m
  15. ;;; =========== for Test only =========================================7 [9 }/ V, _4 Y
  16. ;;; 删除线段内的短线
    $ B" R$ w8 F* Z4 T# [6 s  h( h! r
  17. ;; ssen = Line Selection
    ' `0 E' B5 ?9 E$ C0 r3 R
  18. (setq nn (sslength ssen))
    - S; u& r$ B- S/ ?* {: @
  19. (cond& F6 O& z0 j1 Q4 E4 r' {
  20.   ((< nn 2) nil)                        ; Nothing to do% `; A' {/ ^4 H; m( T9 q6 ]
  21.   (T
    0 j/ @0 v" a0 Z
  22.    (princ "\nProceeding with Line ....."
    - ]- S6 @+ }6 N& ]+ Q2 V9 Z
  23.    (while (setq ee (ssname ssen (setq nn (1- nn)))) . i& o( m; _" s- j* y
  24.      (cond
    $ k8 O: v) d" R7 {& |& ~
  25.        ((null (entget ee)))                ; bypass
    1 b2 P1 b* x0 h" U2 I0 x- N, q( @" b6 U
  26.        (T
    : s& u+ k' h8 D* I# y3 X' K: ~
  27.         (setq p1  (dxg 10 ee)6 N( y( S( x8 [, D0 d
  28.               p2  (dxg 11 ee)5 |* O# T6 ]4 G+ g6 l3 ?0 K. q/ o" k% e
  29.               v1  (angle p1 p2)) @& H- r) \# c5 W. ~
  30.               e1d (cdddr (cddr (entget ee)))
    ) o+ e- u. L$ L- z4 ^/ v
  31.               sc  (ssget "f" (list p1 p2) '((0 . "LINE")
    8 _+ l$ A5 G7 n. H; k
  32.               sum (if sc (sslength sc))
    , J5 k4 Z  Y* q( h0 [$ l2 u
  33.         )
    - a2 K8 c! E) C7 v: I% \
  34.         (while (and (entget ee) (> sum 0))* B( o# t4 a& p4 h
  35.           (setq e1 (ssname sc (setq sum (1- sum))))# t9 `, I1 b; C1 n9 q+ R3 V1 i
  36.           (cond5 O4 ~8 M+ l5 R1 i
  37.             ((eq e1 ee) nil)                ; Itself% B  N0 |, j: U" R- j5 X# A
  38.             ((equal (cdddr (cdddr (entget e1))) e1d)
    : n- h6 B" c# m  g1 G4 ]+ H) P
  39.              (entdel e1)
    ' Q+ R# Z* P2 {* D
  40.             )
    8 ]( W# B( }/ y$ O1 T, u* o
  41.             (T4 l% \, ~! ^: u6 J0 U2 a
  42.              (setq p3 (dxg 10 e1)
    ' d/ L. K! e" w+ |
  43.                    p4 (dxg 11 e1)/ P. I5 z% n; Q! k, A
  44.                    v2 (if (vpt p1 p3 5); n5 `! l4 f% b* G) q( |, ?
  45.                         (angle p2 p3)7 q& n, B2 W; r8 V4 X5 f+ e6 R4 _
  46.                         (angle p1 p3)$ @9 _  I2 l7 C: a) P) v
  47.                       )
    : [6 r4 p) d' o) j! w' C2 Q3 {
  48.              )
    ) b. t' n8 ^9 N9 @9 z0 ]) z
  49.              (if (< (rem (abs (- v1 v2)) pi) 0.0001), F$ B) Y7 M9 h& Y9 `
  50.                (if (< (distance p3 p4) (distance p1 p2))9 e; E) T( G! i  P$ w6 }
  51.                  (entdel e1)
    + C, {! G2 O) L  G  |% e
  52.                  (entdel ee)# Z. C3 B8 ]4 ]2 S$ F9 A. @3 J
  53.                )3 d2 @+ t3 e* Y, x# h; I
  54.              )
    ' \8 F$ s4 h- q
  55.             )  L5 L9 V4 A9 ]( E; x4 v4 f( w6 j
  56.           )( a( d9 I0 g# t; x2 M+ e
  57.         )
    9 A/ ^: o  Y4 P' B( Z
  58.        )
    * `2 o4 A" Z+ Y- I
  59.      ), I. T( z+ i- T; t8 b5 b) W2 z% \
  60.    )  m/ z# k6 _5 ^5 ^
  61.   )
    4 n) q( i5 t8 E' w+ ~
  62. )
    2 h- p1 [3 |5 J! Q: [4 [8 U- Q

  63. " V6 ?$ y  `9 ^% ?5 X- d
复制代码
1 y& F+ v& l7 Z( M+ g9 j; T8 _
[ 本帖最后由 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 )

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