Hidden lines...

Discussion in 'AutoCAD' started by Patrick Bel, Dec 5, 2003.

  1. Patrick Bel

    Patrick Bel Guest

    Hi,

    I have a drawing with about 1200 line and arc, and want to know
    the best way to check for duplicated line.

    I mean line hidden under another.

    Thanks

    Pat
     
    Patrick Bel, Dec 5, 2003
    #1
  2. Patrick Bel

    R. Wink Guest

    Here is a routine that I use called "strip" that looks for and removes redundant lines. It has only one problem that I've
    found..when representing a spring as an "X" or something ling like that, the routine will remove one line and not the other,
    even if you don't want either removed.
    R. Wink
    =====================================================================
    ; STRIP.LSP Version 1.5 November 1, 1988
    ; By Jamie Clay
    ;
    ; This routine will examine a drawing for redundant LINEs and proceed to
    ; to remove them. This is designed to reduce the size of drawings created
    ; by AutoCAD and AutoShade's DXB output.
    ;
    ; The process is simple, STRIP takes a LINE and adds the start and end points
    ; to create a match value. It will then create a selection set based on a
    ; window defined by the start and end points. Using the match value it will
    ; find other identical lines in the selection set and erase them when found.
    ;
    ;
    (defun c:STRIP (/ a b c erased count sum1 sum2 index)
    (setq count 0)
    (setq erased 0)
    (setq a (entnext))
    (while (/= (cdr (assoc 0 (entget a))) "LINE") ;WHILE #1 - Find first line
    (setq a (entnext a))
    ) ;END WHILE #1
    (setvar "cmdecho" 0)
    (while a ; WHILE #2 - While A is true
    (setq pass (strcat "Pass: " (rtos count 2 0)))
    (grtext -2 pass)
    (setq sum1 (sum a)) ; Create window points and verification sum
    (setq b (ssget "w" ptA ptB)) ; Get all entities in this window
    (if (not b) (setq b (ssget "c" ptA ptB)))
    (ssdel a b) ; Remove first line from selection set
    (if (> (sslength b) 0) ; IF #1 - If more than one line
    (progn ; PROGN #1
    (if (= (sslength b) 1) ; IF #2
    (progn ; PROGN #2
    (if (= sum1 (sum (ssname b 0))) ;IF #3
    (progn ;PROGN #3
    (command "erase" b "")
    (setq erased (1+ erased))
    (prompt (strcat "\rRemoved lines :" (rtos erased 2 0)))
    ) ; END PROGN #3
    ) ; END IF #3
    ) ; END PROGN #2
    (progn ; PROGN #4
    (setq index (1- (sslength b)))
    (setq c 0)
    (repeat (sslength b) ; REPEAT #1
    (setq c (ssname b index))
    (setq sum2 (sum c))
    (if (= sum1 sum2) ; IF #4
    (progn ; PROGN #5
    (entdel c)
    (setq erased (1+ erased))
    (prompt (strcat "\rRemoved lines :" (rtos erased 2 0)))
    (setq index (1- index))
    ) ; END PROGN #5
    (setq index (1- index))
    ) ; END IF #4
    ) ; END REPEAT #1
    ) ; END PROGN #4
    ) ; END IF #2
    (setq a (next a))
    ) ; END PROGN #2
    (setq a (next a))
    ) ; END IF #1
    (setq count (1+ count))
    ) ; END WHILE #2
    (command "redraw")
    (setvar "cmdecho" 1)
    (prompt "\nFinished!")
    (princ)
    ) ; END DEFUN

    ;======================= SUPPORTING DEFUNS =====================
    ;
    ; Find the next Line
    (defun NeXT (x)
    (setq b nil)
    (setq x (entnext x))
    (if x
    (if (/= (cdr (assoc 0 (entget x))) "LINE")
    (while (/= (if x (cdr (assoc 0 (entget x))) "LINE") "LINE")
    (setq x (entnext x))
    )
    )

    )
    (eval x)
    )

    ; Create a match value based on the lines start and end points
    (defun sum (x)
    (setq ptA (cdr (assoc 10 (entget x))))
    (if (assoc 11 (entget x))
    (progn
    (setq ptB (cdr (assoc 11 (entget x))))
    (setq sumX (+ (+ (car ptA) (cadr ptA)) (+ (car ptB) (cadr ptB))))
    )
    )
    )

    ; All done we is loaded
    (prompt "\nC:STRIP - Loaded!")
    (princ)
    
     
    R. Wink, Dec 5, 2003
    #2
  3. Patrick Bel

    R. Wink Guest

    Sorry 'bout that. That routine is the only one I have and thought it might do the guy some good. After all, it works for me
    and I was just trying to help the guy. If you have a better, more versatile one, please post it so I can add it to my
    collection.
    R. Wink
     
    R. Wink, Dec 6, 2003
    #3
  4. Patrick Bel

    Patrick Bel Guest

    Thanks for the lisp

    Pat
    might do the guy some good. After all, it works for me
    versatile one, please post it so I can add it to my
     
    Patrick Bel, Dec 6, 2003
    #4
  5. Unfortunately we don't know which AutoCAD Version you're using. If you
    have the Express Tools and you want to KILL duplicated objects try the
    overkill command.

    Juergen
     
    Jürgen Palme, Dec 6, 2003
    #5
  6. If the entities ARE EXACT DUPLICATES, you can use my deldbl.LSP on my site.
    --

    MichaelB
    www.michaelbulatovich.com

    (if they are different in any way, it WON'T catch it)
     
    Michael Bulatovich, Dec 6, 2003
    #6
  7. Patrick Bel

    R. Wink Guest

    Not everyone pays the $$'s required to get the AutoDe$k's "dick in that ass" addons. A shared LISP routine that runs in R14
    or R15 can, for the most part, be made to run in almost any other version and serve the majority of the people that visit
    this forum.
    Now, if you don't like the LISP I posted, post a better one..
    R. Wink
     
    R. Wink, Dec 6, 2003
    #7
  8. Patrick Bel

    bestafor Guest

    ;;NoDupchk.lsp
    ;; Jason Osgood
    ;; 15 Feb 92

    =============================================

    ;; Utility functions
    ;;==================
    ;-----
    ;** Returns data from a keyed field whithin an association list
    (DeFun Get (a b)
    (Cdr
    (Assoc a b)
    )
    )
    ;-----
    ;** Replaces the entity name in an association list with a 0
    (DeFun NilName (edata)
    (SubSt
    (Cons -1 0) (Assoc -1 edata) edata)
    )
    ;-----
    ;; Main Function
    ================
    (DeFun C:DupChk ()
    ;/ pickset1 pickset2 i j ename1 ename2 edata1 edata2 layer)
    (Prompt "\nSelecting entities...")
    (SetQ pickset1
    (SsGet "x")
    );SetQ
    (setq totlen (sslength pickset1))
    (setq dupcnt nil)
    (SetQ i -1) ;initialize first counter
    ;continue processing selection set until there are no more entities
    (While
    (SetQ ename1
    (SsName pickset1
    (SetQ i
    (1+ i)
    );SetQ
    );SsName
    );SetQ
    ;make sure the user knows something is happening
    (Princ "\nFetching entity #")
    (Princ i)
    (princ " of : ")
    (princ totlen)
    (Cond
    ((SetQ edata1 (EntGet ename1))
    (SetQ edata1 (NilName edata1) ;get entity data, drop entity name
    etype (Get 0 edata1) ;get entity type
    layer (Get 8 edata1) ;get entity layer
    );SetQ
    )
    );cond
    ;select all entities of the same type on the same layer
    (Cond
    ((SetQ pickset2
    (SsGet "x"
    (List
    (Cons 0 etype) (Cons 8 layer)
    );List
    );SsGet
    );SetQ
    (SsDel ename1 pickset2) ;remove the "source" entity
    ;from the selection set
    ;let the user know something is happening
    (Princ "\nNear matches: ")
    (Princ
    (SsLength pickset2)
    );Princ
    ;intitialize second counter
    (SetQ j -1)
    (Princ " Comparing # ")
    (While ;continue while all the following
    ;are true
    (And ;always true
    (SetQ k j) ;get the entity from the selection
    set
    (SetQ ename2
    (SsName pickset2
    (SetQ j
    (1+ j)
    );SetQ
    );SsName
    );SetQ
    ;this expression returns False (nil) if an entity was deleted
    (Progn
    ;backspace over previous number
    (While
    (Progn
    ; (Princ "\010")
    (princ "\n")
    (Not
    (ZeroP
    (SetQ k
    (/ k 10)
    );SetQ
    );ZeroP
    );Not
    );Progn
    );While
    (Princ j)
    (SetQ edata2 (EntGet ename2)
    edata2 (NilName edata2)
    );SetQ
    (Cond
    ;test to see if two entities are the same
    ((Equal edata1 edata2 1.0e-10)
    ;if so, delete the entity from the database and primary selection set
    (EntDel ename2)
    (SsDel ename2 pickset2)
    (Princ " Duplicate deleted.")
    ;return False, break out of loop
    nil
    );Cond3a
    ;return True, continue porcessing
    (T)
    );Cond 3
    );Progn
    );And
    );While
    );Cond 2
    );Cond 1
    );While 1
    ;(ReDraw)
    (Princ)
    );________________________________End of File
     
    bestafor, Dec 6, 2003
    #8
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.