|
"How can I determine if lines are
duplicate or fragmented lines contained
in that line (lines that are over lines) so they can removed from the
drawing?"
And the answer :
Hello ,
Here is the code to find and delete overlapped
(not overlapping) lines.
It highlights lines that are fully overlapped (embedded) by other lines, and
asks the user whether he wants to delete it.
The user has two choices:
1) Select all lines in the drawing (default option).
2) Select lines by window.
I have tried it successfully on a small
drawing.
There is still scope for
a) Error handling
b) Code optimization and
c) User interface.
But important thing is, it works. (AutoCAD
2000 compatible.)
You are all welcome to abuse test it and
suggest errors, improvements or new features, or simply send your comments.
mailto:sanganaksakha@freelance-worker.com
;;; ======================
(defun c:Overlap ()
(setq oOSMODE (getvar "OSMODE"))
(Setvar "OSMODE" 0)
(setq oCMDECHO (getvar "CMDECHO"))
(Setvar "CMDECHO" 0)
(setq vZERO 8.8817843e-16)
(Setq ss1 (ssadd))
(Setq ss2 (ssadd))
(initget "All Window ")
(setq selOption
(getkword
"Select Objects; [window] or All : "
)
)
(If (= selOption "Window")
(progn
(setq
s1 (getcorner
(setq f1
(getpoint
"Specify first corner: "
)
)
"Specify opposite corner: "
)
)
(While (= (sslength ss1) 0)
(Command "_Zoom" "_W" f1 s1)
(Setq ss1 (ssget "_w" f1 s1))
)
)
(progn
(Command "_zoom" "_e")
(setq SS1 (ssget "_x" '((0 . "LINE"))))
)
)
(setq
TotLines (sslength ss1)
) (if (< TotLines 2)
(progn
(Alert
"No overlapping lines found in the selection!\n\n
The program ends!!"
)
(setvar "CMDECHO" oCMDECHO)
(setvar "OSMODE" oOSMODE)
(princ)
(exit)
)
)
(setq lDone 0)
(While (< lDone TotLines)
(setq bLine (ssname ss1 lDone))
(setq lDone (1+ lDone))
(setq pt (cdr (assoc 10 (entget bLine))))
(setq ss2 (ssget "_c" pt pt '((0 . "LINE"))))
(if (/= ss2 nil)
(processSS1)
)
)
(setvar "CMDECHO" oCMDECHO)
(setvar "OSMODE" oOSMODE)
(princ)
)
(defun ProcessSS1 ()
(if (> (sslength ss2) 1)
(progn
(setq ss2 (ssdel bLine ss2))
(while (> (sslength ss2) 1)
(ssdel (ssname ss2 (- (sslength ss2) 1)) ss2)
)
(setq pt1
(cdr
(assoc 10
(entget bLine)
)
)
)
(Setq pt2
(cdr
(assoc 11
(entget bLine)
)
)
)
(setq sLine (ssname ss2 0))
(setq sLinEdata (entget sLine))
(setq pt3 (cdr (assoc 10 sLinEdata))
pt4 (cdr (assoc 11 sLinEdata))
)
(processSS2)
)
)
)
(defun ProcessSS2 ()
(if (= (inters Pt1 Pt2 pt3 Pt4)
nil
)
(progn
(if
(or
(And
(< (abs (- (angle Pt3 Pt1)
(angle Pt3 Pt2)
)
)
vZERO
)
(< (abs (- (angle Pt4 Pt1)
(angle Pt4 Pt2)
)
)
vZERO
)
(and
(/= (distance Pt1 Pt3) 0)
(/= (distance Pt2 Pt4) 0)
)
(and
(/= (distance Pt1 Pt4) 0)
(/= (distance Pt2 Pt3) 0)
)
)
(or
(and
(= (distance Pt1 Pt3) 0)
(= (distance Pt2 Pt4) 0)
)
(and
(= (distance Pt1 Pt4) 0)
(= (distance Pt2 Pt3) 0)
)
)
(and (or (= (distance Pt1 Pt3) 0)
(= (distance Pt1 Pt4) 0)
(= (distance Pt2 Pt3) 0)
(= (distance Pt2 Pt4) 0)
)
(or (> (abs
(- (angle Pt3 Pt1)
(angle Pt3 Pt2)
)
) vZero
)
(> (abs
(- (angle Pt4 Pt1)
(angle Pt4 Pt2)
)
) vZero
)
) ;_ end of or
)
)
(progn
(vl-load-com)
(setq obj1
(vlax-ename->vla-object bLine)
)
(vla-highlight obj1 "True")
(initget "Yes No")
(setq delLin
(getkword
"This line is being 'embedded' by another line.\n\n
You can confirm by zooming transparently.
\n\nDo you want to delete it? [No] or Yes: "
)
)
(if (= delLin "Yes")
(progn
(entdel bLine)
(ssdel bLine ss2)
)
)
(command "_regen")
)
)
)
)
)
(alert
"Type 'Overlap' at the command
prompt to run this program"
)
;;; ================
| 
