See the top rated post in this thread. Click here

Page 1 of 2 12 LastLast
Results 1 to 10 of 14

Thread: LISP for Intersection Clean Up

  1. #1
    Active Member zorroxxxx's Avatar
    Join Date
    2002-12
    Posts
    93
    Login to Give a bone
    0

    Question LISP for Intersection Clean Up

    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
    Attached Files Attached Files

  2. #2
    AUGI Addict
    Join Date
    2015-12
    Location
    Arizona
    Posts
    2,478
    Login to Give a bone
    0

    Default Re: LISP for Intersection Clean Up


  3. #3
    Active Member zorroxxxx's Avatar
    Join Date
    2002-12
    Posts
    93
    Login to Give a bone
    0

    Talking Re: LISP for Intersection Clean Up

    Quote Originally Posted by mjfarrell

    Hi Michael,

    Your link went to the B-C section of the site. Did you have a specific file in mind? I browsed the section and did not see anything that would work. Is there one there that can be modified to do what I need?

    Thanks in advance,

    Gary

  4. #4
    AUGI Addict sinc's Avatar
    Join Date
    2004-02
    Location
    Colorado
    Posts
    1,986
    Login to Give a bone
    2

    Default Re: LISP for Intersection Clean Up

    I've wanted something similar in the past, so I figured I'd have a go at it. This is my first attempt at using the ActiveX interface, so some things might have been accomplished more easily in another way, but this works.

    It lets you select a set of objects (any drawing objects should work, although results are unpredictable for circles). Any objects that intersect two and only two of the other objects in the selection set will be broken between the intersection points. If a given object has more than two intersections, then the code wouldn't know which segments to remove. It would need to be extended to allow the user to specify which segments to remove, possibly by selecting inside the desired intersections as you proposed, although I haven't yet figured out the best way of going about it. Feel free to tackle it yourself.

    The code loops until you hit enter or right-click without selecting any objects.

    Code:
    ;; takes a selection set, and trims the gap between intersection points for
    ;; all objects that intersect two and only two of the other objects in the set
    ;; Richard Sincovec, July 11 2004
    
    (vl-load-com)
    (defun c:itrim (/ acadObj doc ssets ss count err i j items item	intxlist
    		intitem)
      (setq	acadObj	(vlax-get-acad-object)
    	doc	(vla-get-activeDocument acadObj)
    	ssets	(vla-get-selectionSets doc)
      )
      (setq	err (vl-catch-all-apply
    	      (function
    		(lambda	()
    		  (setq ss (vla-add ssets "ZYZ_ITRIM"))
    		) ;lambda
    	      ) ;function
    	    ) ;vl-catch-all-apply
      ) ;setq
      (if (vl-catch-all-error-p err)
        ;; error is probably "ss already exists"
        ;; it shouldn't yet, but use it if it does
        (setq ss (vla-item ssets "ZYZ_ITRIM"))
      ) ;if
      (while ; (MAIN)
        (progn
          (vla-clear ss)
          (vla-selectOnScreen ss)
          (setq count (vla-get-count ss))
          (/= count 0)
        ) ;progn
         (setq i count
    	   items nil
         ) ;setq
         (while (/= i 0)
           (setq i	      (1- i)
    	     item     (vla-item ss i)
    	     j	      count
    	     intxlist nil
           ) ;setq
           (while (/= j 0)
    	 (setq j       (1- j)
    	       intitem (vla-item ss j)
    	 ) ;setq
    	 ;; I kept getting an exception on vlax-safearray->list
    	 ;; if intersectWith found no points, and couldn't figure
    	 ;; out offhand how to stop getting it, so I decided to catch
    	 ;; and ignore it instead
    	 (if (/= (vla-get-handle item) (vla-get-handle intitem))
    	   (vl-catch-all-apply
    	     (function
    	       (lambda ()
    		 (setq
    		   intx	    (vlax-safearray->list
    			      (vlax-variant-value
    				(vla-IntersectWith
    				  item
    				  intitem
    				  acExtendNone
    				)
    			      )
    			    )
    		   intxlist (append intxlist (list intx))
    		 ) ;setq
    	       ) ;lambda
    	     ) ;function
    	   ) ;vl-catch-all-apply
    	 ) ;if
           ) ;while j
           ;; if we found two and only two intersections, store the entity for breaking
           ;; if we break it now, it will confuse the rest of the intersection checking
           (if (= (length intxlist) 2)
    	 (setq
    	   items (append
    		   items
    		   (list (cons (vlax-vla-object->ename item) intxlist))
    		 )
    	 )
           ) ;if
         ) ;while i
         ;; break the items
         (foreach item items
           (command	"break"
    		(list (car item) (cadr item))
    		(caddr item)
           )
         ) ;foreach
      ) ;while (MAIN)
      (vla-delete ss)
      (princ)
    ) ;defun

  5. #5
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    2

    Default Re: LISP for Intersection Clean Up

    here is a little routine that I cooked up. Just select the 4 lines to trim and it should clip them the way you want.

    Peter Jamtgaard

    Code:
    (defun C:TRIMIT3 (/ intCount 
                       lstPairs3                  
                       lstPoints3
                       lstPoints4
                       lstObjects
                       lstObjects2
                       lstObjects3
                       ssSelections  )
    
     (setq ssSelections (ssget (list (cons 0 "*line,arc"))))
     (repeat (setq intCount (sslength ssSelections))
      (setq intCount   (1- intCount)
            lstObjects (cons (vlax-ename->vla-object (ssname ssSelections intCount))
                             lstObjects
                       )
      )
     )
     (repeat (setq intCount (length lstObjects))
      (setq intCount     (1- intCount)
            objSelection (nth intCount lstObjects)
            lstPairs3    nil
      )
      (repeat (setq intCount2 (length (setq lstObjects2 (vl-remove objSelection lstObjects))))
       (if (not 
            (vl-catch-all-error-p
             (vl-catch-all-apply
             '(lambda (X Y)
               (setq varPOint (vla-intersectwith X Y 0))
              )
              (list objSelection (nth (1- intCount2) lstObjects2))
             )
            )
           )
        (progn
         (if (safearray-value (variant-value varPoint))
          (progn 
           (setq lstPoint  (vlax-safearray->list (variant-value varPoint))
                 lstPairs3 (cons (cons (vlax-curve-getparamatpoint objSelection lstPoint)
                                         lstPoint                                   
                                   )
                                   lstPairs3
                             )
           )
          )
         )
        )
       )
       
       (setq intCount2 (1- intCount2))   
      )
      (if lstPairs3
       (progn
        (setq lstPairs3  (sortList lstPairs3 0)
              lstPoints3 (mapcar 'cdr lstPairs3)
    
        )
       )
      )
      (setq lstPoints4 (cons (cons objSelection (reverse lstPoints3))
                             lstPoints4
                       )
            lstPoints3 nil
            lstPairs   nil
      )  
     )
     (foreach lstN lstPoints4
      (setq objSelection (car lstN)
            lstN         (cdr lstN)
      )
      (repeat (/ (length lstN) 2)
       (vl-cmdf "break"           
                (vlax-vla-object->ename objSelection)            
                "F"
                (car lstN)
                (cadr lstN)
       )
       (setq lstN (cddr lstN))
      )
     )
    )
    (defun SortList (lstOfLists intItem)
     (vl-sort lstOfLists '(lambda (n1 n2) (<= (nth intItem n1) (nth intItem n2))))
    )

  6. #6
    Active Member zorroxxxx's Avatar
    Join Date
    2002-12
    Posts
    93
    Login to Give a bone
    1

    Talking Re: LISP for Intersection Clean Up

    Thanks to all for solving my problem.

    Richards' file worked great for individual intersections and Peter's file worked for individual and multiple intersections. Thanks to Michael for a link to a good LISP resource.

    As a beginner in the world of LISP maybe someday I'll be able to help someone as you have.

    THANKS!!!

    Gary

  7. #7
    Active Member zorroxxxx's Avatar
    Join Date
    2002-12
    Posts
    93
    Login to Give a bone
    0

    Lightbulb Re: LISP for Intersection Clean Up

    Peter,

    Your file only seems to work in Acad 2004. I emailed it to my work and could not get it to run on Acad 2002.

    Is there a way to modify your file to get it working in 2002?

    Thanks in advance,

    Gary

  8. #8
    I could stop if I wanted to
    Join Date
    2002-02
    Location
    Kansas
    Posts
    487
    Login to Give a bone
    0

    Default Re: LISP for Intersection Clean Up

    add

    (vl-load-com)
    to the start of peter file as richards did and it will work in in 2002

  9. #9
    100 Club Lemons's Avatar
    Join Date
    2001-06
    Location
    Beautiful Charleston, SC
    Posts
    182
    Login to Give a bone
    0

    Default Re: LISP for Intersection Clean Up

    I just use a fillet crossing with a zero radius to do this:

    (defun c:fc () (command "undo" "m") (command "fillet" "R" "0") (command "fillet" "c"))

  10. #10
    AUGI Addict sinc's Avatar
    Join Date
    2004-02
    Location
    Colorado
    Posts
    1,986
    Login to Give a bone
    0

    Default Re: LISP for Intersection Clean Up

    If you try the routines we posted, you'll see they do something different. They actually do the equivalent of breaking four lines and then running your fc function four times... (in the simplest case, anyway...)

Page 1 of 2 12 LastLast

Similar Threads

  1. drawing clean up lisp
    By cadd4la in forum AutoLISP
    Replies: 3
    Last Post: 2015-05-23, 02:45 PM
  2. Lisp to clean and save in DXF format
    By antistar in forum AutoLISP
    Replies: 1
    Last Post: 2012-12-20, 07:14 PM
  3. LISP Blocks intersecting clean up help.
    By james.hodson in forum AutoLISP
    Replies: 12
    Last Post: 2010-01-15, 11:19 PM
  4. Dimensioning and intersection or aparent intersection a no go.
    By kb3cxe in forum AutoCAD LT - General
    Replies: 2
    Last Post: 2006-05-08, 04:32 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •