明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 10523|回复: 20

请教陈大虾,这程序为什么不好用

  [复制链接]
发表于 2003-7-2 18:07:00 | 显示全部楼层 |阅读模式
程序目的:擦除重复的线条问题:一次选的对象过多,就会有一些线擦不掉,甚至一条也不擦 选的对象不多是可以用 千万指教!

本帖子中包含更多资源

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

x
发表于 2003-7-3 12:39:00 | 显示全部楼层
;;試試這個擦除重复物件
;| Programmed by Dave Aguilar
   DUPREM.LSP <c> 1994 Onyx Software

This program creates an list of entity lists for all entities in the
drawing (using the first VERTEX for POLYLINES) and then compares each
entity list with the total list, building a new selection set of all
duplicate entries which are then erased.

it's not guarenteed but try it on a copy of a badly duplicated drawing
and see if it helps.

------------------------------------------------------------------------
------------------------------------------------------------------------
Modified by J. Tippit, SPAUG President    08/25/99
    E-mail:                     cadpres@spaug.org
    Web Site:                http://www.spaug.org

1. Modified to work with R14 & 2000
2. Now prompts for 3 types of selection sets
3. Works on all types of entities (including LWPOLYLINES)

Large donations to SPAUG is appreciated. :)
------------------------------------------------------------------------
------------------------------------------------------------------------

|;

(defun C:DUPREM        (/ F1 SLE SA CA        TA LA LB ENTA EA TYPA A1 A2 A3 A4 SC
                 LTEST TES
                )
  (setvar "cmdecho" 0)
  (setq        F1 NIL
        F1 0
  )
  ;; Added by Jeff Tippit 08/25/99
  ;; Start
  (or :GCHOICE (setq :GCHOICE "Set"))
  (initget "Set Limits All")
;;;   (setq SLE (getkword "\nSelect objects by <S>election set, <L>imits, or <E>ntire database: "))
  (setq        SLE
         (getkword (strcat "\nType of selection [Set/Limits/All] <"
                           :GCHOICE
                           ">: "
                   )
         )
  )
  (if (not SLE)
    (setq SLE :GCHOICE)
    (setq :GCHOICE SLE)
  )
  (cond
    ((= SLE "Set") (setq SA (ssget)))
    ((= SLE "Limits")
     (setq SA (ssget "c" (getvar "extmin") (getvar "extmax")))
    )
    ((= SLE "All") (setq SA (ssget "X")))
  )

  (if (and SA (= (type SA) 'PICKSET) (not (zerop (sslength SA))))
    (progn
      (setq CA 0
            TA (sslength SA)
            LA NIL
            LB NIL
      )
      (while (< CA TA)
        (setq ENTA (ssname SA CA)
              EA   (cdr (entget ENTA))
              TYPA (cdr (assoc 0 EA))
        )
        ;;      (if (= typa "OLYLINE") (progn
        ;;         (setq entb (entnext enta) ea (cdr (entget entb)))
        ;;      ))
        ;; Added by Jeff Tippit 08/25/99
        ;; Updated for R14 & 2000
        ;; Start
        (setq A1 (assoc 5 EA))
        (setq A2 (cons 5 ""))
        (setq EA (subst A2 A1 EA))
        (if (wcmatch (getvar "ACADVER") "*15*")
          (progn
            (setq A3 (assoc 330 EA))
            (setq A4 (cons 330 ""))
            (setq EA (subst A4 A3 EA))
          )
        )

        (setq LA (cons ENTA LA)
              LB (cons EA LB)
              CA (+ CA 1)
        )
      )
      (setq SC          NIL
            SC          (ssadd)
            LTEST LB
      )
      (setq CA 0)
      (setq TES          (car LTEST)
            LTEST (cdr LTEST)
            TA          NIL
            TA          (length LTEST)
      )
      (while (/= TA 0)
        (if (member TES LTEST)
          (progn
            (setq SC (ssadd (nth CA LA) SC))
            (prompt "\nFound duplicate entity.")
            (setq F1 (+ F1 1))
          )
        )
        (setq CA (+ CA 1))
        (setq TES   (car LTEST)
              LTEST (cdr LTEST)
              TA    (length LTEST)
        )
      )
      (command "erase" SC "")
      (redraw)
      (prompt "\n")
      (prin1 F1)
      (prompt " duplicate entities erased.")
    )
  )
  (princ)
)
(prompt
  "\nType DUPREM to run. Delete duplicate entity routine Ver 2.0 loaded."
)
(princ)
 楼主| 发表于 2003-7-7 18:43:00 | 显示全部楼层
谢谢龙哥,我先试一试
发表于 2003-9-19 14:02:00 | 显示全部楼层
龙哥,这程序不好用,您试了吗?再来点中文注释好吗?谢谢!!!
发表于 2003-9-19 16:23:00 | 显示全部楼层
这程序那裡不好用可以說說嗎?
发表于 2003-9-19 17:00:00 | 显示全部楼层
我用来消除重复得线、圆、圆弧,但不行,Set/Limits/All分别代表什么意思?我都试了,老是
0 duplicate entities erased.麻烦龙哥了!!!
发表于 2003-9-24 13:42:00 | 显示全部楼层
龙龙仔的程序不错,但好像对块就没用了。
发表于 2003-9-24 13:56:00 | 显示全部楼层
不能刪除的. 好象這里有幾條,但是效果麻麻地.
发表于 2003-11-11 12:02:00 | 显示全部楼层
龙龙仔的程序不错,太强了。我真的很需要。
发表于 2004-3-24 10:18:00 | 显示全部楼层
龙龙仔你的程序太好了,而且非常实用。



但是能不能把有重叠的实体,亮显,呈选中状态。不用自动删除。


待查过之后再手工删除。


我只是担心不知删的是哪个实体,是否真的是无用的实体。


非常感谢!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-7-22 01:49 , Processed in 0.204021 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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