Nice Joe,
It did however crash autocad under certain situations,
specifically, when the intersection picked was not entirely
closed (boundary failure leads to activeX failure when entlast
is not a polyline). Crash occurs sometimes
after undoing the operation.
Suggest adding a check to see if the last entity is a new
polyline entity.
Regards,
Doug
"Joe Burke" wrote in message news:40f3cd9a$1_1@newsprd01...
> Gary,
>
> Just fooling around with how it might be done without selecting objects. One click,
> pick point. Seems to work fairly well with arcs and lines given your examples. It's
> certainly not bulletproof and needs more error checking. Zoom in/out is annoying, but
> the break commands are more reliable this way.
>
> Joe Burke
>
> (defun c:CleanIntersections ( / *Error* doc osm pkbx pt tempobj coord
> ptlst p1 p2 p3 p4 zmpt1 zmpt2 )
>
> (defun *Error* (Msg)
> (cond
> ((or (not Msg)
> (member Msg '("console break"
> "Function cancelled"
> "quit / exit abort"))))
> ((princ (strcat "\nError: " Msg)))
> )
> (setvar "osmode" osm)
> (setvar "cmdecho" 1)
> (princ)
> ) ;end
>
> (defun MidPoint (p1 p2)
> (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5))
> ) ;end
>
> (setq doc (vla-get-activedocument (vlax-get-acad-object)))
> (setq osm (getvar "osmode"))
> (setvar "osmode" 0)
> (setvar "cmdecho" 0)
>
> (while
> (setq pt (getpoint "\nPick point inside intersection: "))
> (vla-StartUndoMark doc)
> (command "-boundary" pt "")
> (setq tempobj (vlax-ename->vla-object (entlast)))
> (setq coord (vlax-get tempobj 'Coordinates))
> (vla-delete tempobj)
> (repeat 4
> (setq ptlst (cons (list (car coord) (cadr coord)) ptlst))
> (setq coord (cddr coord))
> )
> (setq ptlst (mapcar '(lambda (x) (trans x 0 1)) ptlst))
> (setq p1 (MidPoint (car ptlst) (cadr ptlst)))
> (setq p2 (MidPoint (cadr ptlst) (caddr ptlst)))
> (setq p3 (MidPoint (caddr ptlst) (last ptlst)))
> (setq p4 (MidPoint (car ptlst) (last ptlst)))
> (setq zmpt1 (polar pt 0.0 (* (distance p1 p3) 5)))
> (setq zmpt2 (polar pt pi (* (distance p1 p3) 5)))
> (command "zoom" "w" zmpt1 zmpt2)
> (command "_break" p1 "F" (car ptlst) (cadr ptlst)
> "_break" p2 "F" (cadr ptlst) (caddr ptlst)
> "_break" p3 "F" (caddr ptlst) (last ptlst)
> "_break" p4 "F" (car ptlst) (last ptlst))
> (command "zoom" "p")
> (vla-EndUndoMark doc)
> (setq ptlst nil)
> ) ;while
> (*Error* nil)
> (princ)
> ) ;end
>
>
> > Hi,
> >
> > Does anyone have a LISP or Script that will clean up intersections? Both linear and
> radius intersections. I have been constantly trimming and after a few hundred
> thousand clicks, I figure there has to be an easier way. I've also have tried using
> BPOLY command but it creates polylines on top of existing lines, which I then have to
> delete. I am just learning LISP so I'm not sure how to conquer this problem.
> >
> > I have attached a .BMP file which shows exactly what I'm looking for.
> >
> > I run Vanilla ACAD 2002
> >
> > Any help will be greatly appreciated
> >
> > Gary
>
>