QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

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

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

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

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

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

x
   在网上找的一个删除重复图元的LISP程序 加载使用后发现对重复线段的删除有时候无效 而且线段内部的线段无法删除 就是说如果一条线段长100一条长50 使用这个删除不掉!!请高手帮忙修改下!!+ _# E2 N# \$ J
 以下是程序原文:(附件内容是程序源文件)
7 |; I& S$ a9 W/ V! A7 h3 o(defun c:ere()
( S1 d( ]* J' |) C# j6 z1 A9 ~  (setq m0 (getpoint "\n左下角:"))! X' }* m9 i. v
  (setq m1 (getpoint "\n右上角:"))6 j2 L6 l7 w. J3 D8 _2 A; _
  (setq x0 (car m0) x1 (car m1) y0 (cadr m0) y1 (cadr m1) m2 m0 x2 x0 y2 y0)8 J2 t6 H8 B3 p0 q+ ]% a* o
  (while (< x2 x1)7 e  d2 R  L) E4 H5 |/ z6 p
    (setq y2 y0 m3 m2)
8 Q+ Z6 [5 P$ k+ l3 S! M3 ]' b    (while (< y2 y1)* F4 r' [. a! b) e8 a5 n6 ^3 F$ y
      (setq m4 (polar m3 0.785398 70.72)), o2 k4 Y* x% v4 z  o; D. d, J
      (setq a (ssget "_C" m3 m4))
( d& t8 `- y. s* N+ ~# J      (if (not a)(setq i 0)(setq i (sslength a)))/ o5 ~, C7 T6 p% a+ q
      (while (> i 1)
* M4 K2 a7 o6 J; u' ^        (setq j (- i 1))
. |( v* r$ e9 L" k4 z& d3 P" U# h        (setq b (ssname a (setq i (1- i)))) ;(setq b (ssname a 1))7 d1 m. E: N6 z/ ?; ~/ e* x4 z; j
        (setq c (entget b))
% f. A3 F% {9 f6 w% u  N; o9 b        (setq d (cdr (assoc 0 c)))7 u7 p$ Y$ N2 H+ ?! n- ^0 c
        (while (> j 0)
# K* ]3 Q/ m+ n) K+ U          (setq b1 (ssname a (setq j (1- j))))
) @9 ]0 K# J1 @  x& M          (setq c1 (entget b1))9 p. r8 T, y. k' f1 x# h2 G3 \* z
          (setq d1 (cdr (assoc 0 c1)))
) v5 v" r2 o! l7 }4 p5 \          (if (= d d1)
) o4 e5 o+ h4 E  U% L. D/ G! {            (if (= d "LINE")" |$ ?3 ?7 h7 N" w
              (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
, Y0 m+ E. R0 D3 W                       (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))
" Y( \4 X* b1 @; u5 e: o2 k                       (= (rtos (cadr (assoc 11 c)) 2 4)(rtos (cadr (assoc 11 c1)) 2 4))) P: ]! W+ s4 |, Q3 C
                       (= (rtos (caddr (assoc 11 c)) 2 4)(rtos (caddr (assoc 11 c1)) 2 4))
* a/ ^0 U& A( @$ ]  h9 Q* k                  )(command "erase" b1 "")( s8 \' C, i6 W8 p) ~% F
              ): r' n( x0 A5 Y: O! R% Q
              (if (= d "INSERT")6 n" h) w- d6 Z+ i3 O. c; R, x8 {
                (if (and (equal (assoc 2 c) (assoc 2 c1))
: D" b: v4 }, v9 }- P7 l0 ^                         (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
6 O/ Q: h2 r; v- z) t' f  O                         (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))# s' ~/ D7 O7 s( b& o8 P/ M
                    )(command "erase" b1 "")
4 H+ Z/ \  j6 K  U# ]                ): \, \. e; I  j/ U/ }
                (if (= d "LWPOLYLINE")
+ C9 q. r/ p3 N                  (progn" d: N; l  s" ~- G5 b3 b4 p1 D
                    (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1))+ Z% n1 J' x: w# i
                    (while (and e e1); ]) T+ Y% R* J+ t5 o% B" Q' K
                      (progn 6 v" B. Z% S  K+ e; I
                      (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))9 V2 X: m' I: G, j) Q
                      (while (and e (/= (car f) 10))(setq f (car e) e (cdr e)))7 S% I2 J* D. Y" ?, m" j
                      (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1))); V7 o; v% B4 ?- E* i5 T
                      (if (or (/= (rtos (cadr f) 2 4)(rtos (cadr f1) 2 4))
% }* ?. ~2 S+ D2 i3 t, i                              (/= (rtos (caddr f) 2 4)(rtos (caddr f1) 2 4)))(setq e1 nil)
7 A/ l/ J& K* R5 {& }( v                        (if (not e1) (command "erase" b1 "")(if (not e)1 L2 F) A3 C) K* }, m
                           (progn (command "erase" b "")(setq b b1 b1 nil))))- u; h9 O& d- `$ q; _4 w: |: \
                  ) ) ) )          5 V5 @+ }! u9 O% D' t3 l$ A
                  (if (= d "SPLINE")$ K+ ^: h  u4 g& M* W2 |
                    (progn  T8 Q. L( T. m) U2 C
                      (setq e (cddddr c) e1 (cddddr c1) e (cddddr e) e1 (cddddr e1))  L$ L& G" u) J. c
                      (while (and e e1)
( W" F; U1 I5 D6 J& ~                        (progn 5 V9 _8 Z/ R) P7 I9 }, D$ I
                          (setq f (car e) f1 (car e1) e (cdr e) e1 (cdr e1))
+ s, V* K3 z& J2 ^. Q                          (while (and e (/= (car f) 10))(setq f (car e) e (cdr e)))
+ W5 K4 N* b3 _! }! a* H- i                          (while (and e1 (/= (car f1) 10))(setq f1 (car e1) e1 (cdr e1)))
' P9 `$ N$ K8 t  `' i' _& ~                          (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)7 m' g4 `+ x. ~0 O: k
                            (if (not e1 ) (command "erase" b1 "")(if (not e)(progn (command "erase" b "")(setq b b1 b1 nil))))$ i8 S2 s& X$ L! p
                    ) ) ) )         
' a4 w2 H/ s6 U$ u, `8 b                    (if (= d "TEXT")
3 e/ [& _0 T- X3 i$ ~% K, d/ _8 U                      (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
% n- K/ e- P) n% m9 n                               (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))4 e& C/ f$ ?' o# z
                          )(command "erase" b1 "")
8 I9 k) ?/ [6 Z2 a8 B) g- G                      )
% i% H! _% a8 q; W/ `& h  ]                      (if (= d "CIRCLE")- @' m/ X& v! r& Z
                        (if (and (= (rtos (cadr (assoc 10 c)) 2 4)(rtos (cadr (assoc 10 c1)) 2 4))
( z( R6 P$ u/ Y" u, O+ S: W7 Z! @                                 (= (rtos (caddr (assoc 10 c)) 2 4)(rtos (caddr (assoc 10 c1)) 2 4))
1 ?& S, u- D* M0 O  N                                 (= (rtos (cdr (assoc 40 c)) 2 4)(rtos (cdr (assoc 40 c1)) 2 4))
( ~. \2 q3 x( E! r( Q3 X6 H                            )(command "erase" b1 "")! ]( \5 E8 y' @/ k; h2 C
      ) ) ) ) ) ) ) ) ) )8 P! ^- x* I' n4 n1 o7 d
      (setq m3 (polar m3 1.5708 50.0) y2 (+ y2 50.0))
- V  ]8 w7 F" x& k, _    )" K: l2 D2 ^$ t9 X! O  C& p
    (setq m2 (polar m2 0.0 50.0) x2 (+ x2 50.0))
" a# l& B! a- w) y  )
8 j& v8 c$ }7 a. T7 _( j4 e  (princ)
8 S# b4 r0 x4 b% J& {/ D)# G, |: k& `* S. U& `, H. z* M
(princ "\n\"ere\"启动")
, k* w1 f3 z# ?" c/ z( h9 G, [
5 [3 k! h$ ^7 ^2 B[ 本帖最后由 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+ z+ c$ `. T  t  T3 @. ~7 L7 Z
有没有中间使用变量得说明?做什么用得?
6 p. y8 z9 n; x0 u: k
没有 这个程序用来删除多余的图元。程序特点,可以删除完全重合的直线、多段线、光滑曲线(程序中设置了4位小数,当坐标数值四舍五入精确到4位小数时认为重合),删除位置重合的文字,删除位置和半径相同的圆,删除位置和块名相同的块。
发表于 2008-12-6 15:17:15 | 显示全部楼层 来自: 中国四川成都
给你一个思路:
$ x3 ]! S, |; `0 F5 K+ o    处理"LINE"时,增加一个判定函数,用于首先判定直线L1的两个端点是否在直线L2上面;若在,再判定直线L1的两个端点是否在直线L2的两个端点以内,则返回直线L1,否则返回直线L2。
/ X$ U6 r+ X( N1 s; ^5 g: j( G    判定直线L1的两个端点是否在直线L2上面:
, X- y* w$ w4 B: `8 i       可以逐点计算直线L1的两个端点到直线L2的距离是否小余你的精度要求,若小余,则判定为该点在直线L2上,否则,该点不在直线L2上。

评分

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

查看全部评分

发表于 2008-12-6 22:42:04 | 显示全部楼层 来自: 中国台湾
  1.     ' t  h6 i5 {" y6 a9 S) P
  2.     (defun dxg (code ele)
    7 [; E1 ~' g9 U7 y  ~7 V- b8 n
  3.       (cdr (assoc code (entget ele)))2 M% c+ y) S5 q$ g+ ~3 I' A+ b7 P
  4.     ). b9 e" u' \0 A6 v$ u+ Q/ g
  5.        3 Q, F/ F, e' ?+ f
  6. ' ?3 Y0 R* u% C7 c
  7.     (defun vpt (a b c)
    ' k7 b5 w( G# B" \7 L
  8.        (equal* h$ c+ O5 F: R8 e# G# U5 ^
  9.          (if (caddr a) a (reverse (cons 0.0 (reverse a))))! D/ A+ w8 J+ @" z: M: U4 Z
  10.          (if (caddr b) b (reverse (cons 0.0 (reverse b))))
    . Z8 G8 ]7 h6 i/ R% C
  11.          (expt 0.1 c)2 ]8 i: {3 V% l( _: ]) `
  12.        )
    . O5 b% J& X7 l/ S% d% C
  13.     )
    ! ?+ b. f  C. F5 O* {3 A" `/ r$ {) u. X
  14.     - M  F# r. c  F0 D9 ~7 U
  15. ;;; =========== for Test only =========================================; \5 V; N+ U8 P) ~, a- x
  16. ;;; 删除线段内的短线/ e* f# U/ f3 e! k4 T, Q# \  A
  17. ;; ssen = Line Selection( h6 m% k5 \9 ~( ?; G
  18. (setq nn (sslength ssen))5 ^$ R. l* ~( T
  19. (cond
    . L0 |6 F+ R" F! E0 I  A0 b  }  T8 ~
  20.   ((< nn 2) nil)                        ; Nothing to do
    ( J. _8 W# u, n! }( i
  21.   (T
      b; S0 \5 E; w3 }# ]
  22.    (princ "\nProceeding with Line ....."
    / e+ x: K! d1 ~9 I# z! X& P+ p
  23.    (while (setq ee (ssname ssen (setq nn (1- nn))))
    : P9 Z" N9 f; x9 b
  24.      (cond
    0 g$ Q+ d; X% B1 O9 d9 M9 ]
  25.        ((null (entget ee)))                ; bypass8 Z6 L4 L: l  D1 _; v" L" e/ k
  26.        (T
    1 [0 G3 z6 T8 d3 ^/ I
  27.         (setq p1  (dxg 10 ee)  N5 i( W* C. E9 @8 `. x, }! e
  28.               p2  (dxg 11 ee)
    ! P8 y: F4 x/ Q4 ]$ |, q# u2 q
  29.               v1  (angle p1 p2)
    8 _3 V, d+ q; w8 d
  30.               e1d (cdddr (cddr (entget ee)))
    ' P  |; v6 ^8 ^
  31.               sc  (ssget "f" (list p1 p2) '((0 . "LINE")0 B7 c5 c% ^. `' O" W* ]
  32.               sum (if sc (sslength sc))
    7 w2 m8 J% o1 h! X( i; W$ l
  33.         )
    3 X. [7 a; @$ Q1 j% y$ ]
  34.         (while (and (entget ee) (> sum 0))
    # j) D' t& _. \; @- ]) s! b2 l
  35.           (setq e1 (ssname sc (setq sum (1- sum))))5 @- ]- y3 s7 R
  36.           (cond
    9 S; h4 }- e% e
  37.             ((eq e1 ee) nil)                ; Itself
    ( a. r  |3 P9 {. R2 h7 |7 }
  38.             ((equal (cdddr (cdddr (entget e1))) e1d)
    $ ~. N6 n# J6 S  y3 L2 `, B0 _
  39.              (entdel e1)! j& h2 W0 Y; U+ e' D9 F% Z
  40.             )
    - ]; w7 S8 h1 K& f+ Y; h) l) V
  41.             (T
    , u6 i( X" S4 h. _% c
  42.              (setq p3 (dxg 10 e1)
    , O" ]) d& W3 B9 d
  43.                    p4 (dxg 11 e1)% c  ~) F. j8 R0 S# k
  44.                    v2 (if (vpt p1 p3 5)# Q! }9 C: l; z) r# B
  45.                         (angle p2 p3)" q; i. g# i4 D# M! y5 y
  46.                         (angle p1 p3), Y6 t" x# D) A; M, o
  47.                       )9 A8 o# H6 [* N: ~
  48.              )
    , t0 n! C3 J: Y6 _, Z: }
  49.              (if (< (rem (abs (- v1 v2)) pi) 0.0001)
    6 D" C6 z* C5 o. U
  50.                (if (< (distance p3 p4) (distance p1 p2))
    7 v6 Y2 F; J1 j( h" d% }
  51.                  (entdel e1)
    . S5 A1 b/ y* X1 E% g% c1 s
  52.                  (entdel ee)# j+ z! j4 |4 r4 P% a/ G
  53.                )' }  P; b; q  m  s( U( k3 H
  54.              )! ?( r  Y6 Z( \& X# f
  55.             )/ e2 |  y2 Q; n4 l0 D
  56.           )" |9 t1 w, ~' G3 ^$ k; s1 R6 I+ g
  57.         )1 m3 S8 n! w5 T. V/ m$ H
  58.        )) A" G1 o1 z9 Z
  59.      )
    9 D: o4 Y) z. @# n4 U6 J# R- P
  60.    )! }2 @' t1 X5 G3 J' [/ j3 _
  61.   )" }" v4 W* P- {7 W# ?* p
  62. )* t4 E3 d/ n7 R1 y. ~' ~  M

  63. 9 q8 X0 s, N( o  I9 P/ y+ @
复制代码
7 a; m: z% R0 f
[ 本帖最后由 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 )

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