See the top rated post in this thread. Click here

Page 2 of 2 FirstFirst 12
Results 11 to 14 of 14

Thread: LISP for Intersection Clean Up

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

    Talking Re: LISP for Intersection Clean Up

    Thanks JWANSTAETT,

    That did the trick!

    Once again I want to thank everyone for their help in solving my problem.

    Gary

  2. #12
    All AUGI, all the time BCrouse's Avatar
    Join Date
    2003-04
    Location
    Bethlehem, PA
    Posts
    980
    Login to Give a bone
    0

    Question Re: LISP for Intersection Clean Up

    Will this work with wall styles?

    Thank you

    Brad

  3. #13
    Member jwf's Avatar
    Join Date
    2001-12
    Location
    Westminster, Co
    Posts
    33
    Login to Give a bone
    0

    Talking Re: LISP for Intersection Clean Up

    This one might come in useful as well.
    Code:
    (DEFUN C:inter ()
     ;this section sets some preliminary variables for the program
      (Setvar "CMDECHO" 0)
      (setq ds (getvar "dimscale"))
      (setq zdist (/ ds 3))
      (setq counter 0)
      (setq count2 1)
      (setq ccount 0
     lcount 0
      )
      (Setq pickold (getvar "pickbox"))
      (setvar "pickbox" 7)
      (prompt
    	"This program will explode all polylines to determine if individual line segments"
      )
      (terpri)
      (prompt
    	"intersect other drawing objects. Wait 3 seconds or press esc now to exit"
      )
      (terpri)
      (command "DELAY" "3000")
     ;This section makes a selection set of all poly lines and explodes them one by one
      (setq sspl (ssget "X" '((0 . "LWPOLYLINE"))))
      (if (/= sspl nil)
    	(setq sspllen (sslength sspl))
    	()
      )
      (setq pl 0)
      (while (< pl sspllen)
    	(setq obj (ssname sspl pl))
    	(command "EXPLODE" obj "")
    	(setq pl (+ pl 1))
      ) ;while
     ;This section makes a selection set of all lines in the object database.
      (setq ssl (ssget "X" '((0 . "LINE"))))
      (setq sslen (sslength ssl))
     ;this section finds intersection points of lines and asks the user to break one
      (while (< counter sslen)
    	(setq obja (ssname ssl counter))
    	(setq objadata (entget obja))
    	(setq astart (cdr (assoc 10 objadata)))
    	(setq aend (cdr (assoc 11 objadata)))
    	(while (< count2 sslen)
    	  (setq objb (ssname ssl count2))
    	  (setq objbdata (entget objb))
    	  (setq bstart (cdr (assoc 10 objbdata)))
    	  (setq bend (cdr (assoc 11 objbdata)))
    	  (setq abint (inters astart aend bstart bend))
    	  (if (or (equal bstart aend) (equal bend astart))
     (setq abint nil)
     ()
    	  ) ;if
    	  (if (/= abint nil)
     (progn
       (SETQ ZPOINT1 (POLAR ABINT 0.523 ZDIST))
       (SETQ ZPOINT2 (POLAR ABINT 3.66 ZDIST))
       (COMMAND "ZOOM" "WINDOW" ZPOINT1 ZPOINT2)
       (setq BDIST 0.0443)
       (setq OS (getvar "osmode"))
       (setvar "osmode" 0)
       (initget 1 "Yes No")
       (setq test (getkword
    		 "Would you like to break something here (Y/N)?"
    	   )
       )
       (if (= test "Yes")
    	 (progn
    	   (setq ENT1
    	   (car (entsel "\nSelect crossing line to break: "))
    	   )
    	   (setq LINE1 (entget ENT1))
    	   (setq LN (cdr (assoc 8 LINE1)))
    	   (setq P1 (cdr (assoc 10 LINE1)))
    	   (setq P2 (cdr (assoc 11 LINE1)))
    	   (setq AN (angle P1 P2))
    	   (setq ENT2 (car (entsel "\nSelect line to cross over: ")))
    	   (terpri)
    	   (setq LINE2 (entget ENT2))
    	   (setq P3 (cdr (assoc 10 LINE2)))
    	   (setq P4 (cdr (assoc 11 LINE2)))
    	   (setq IN (inters P1 P2 P3 P4))
    	   (setq BPT1 (polar IN AN (* BDIST (getvar "dimscale"))))
    	   (setq BPT2
    	   (polar IN (+ AN pi) (* BDIST (getvar "dimscale")))
    	   )
    	   (command "break" ENT1 BPT1 BPT2)
    	   (setvar "osmode" OS)
    	   (Prompt "Pausing to show you your selection")
    	   (terpri)
    	   (command "DELAY" "1000")
    	 ) ;progn
       ) ;if
     ) ;progn
     ()
    	  ) ;if
    	  (setq count2 (+ count2 1))
    	) ;while
    	(setq counter (+ counter 1))
    	(setq count2 (+ counter 1))
      ) ;while
      (setvar "pickbox" pickold)
      (Prompt
    	"Please run inters again to ensure all intersecting lines have been broken"
      )
      (terpri)
    ) ;defun
    Last edited by Mike.Perry; 2005-10-24 at 04:29 PM. Reason: [CODE] tags added.

  4. #14
    Woo! Hoo! my 1st post
    Join Date
    2004-08
    Posts
    1
    Login to Give a bone
    0

    Default Re: LISP for Intersection Clean Up

    Quote Originally Posted by cdailey
    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"))
    I'm updating my 2005 "acad.mnu" and "adt.mnu" for buttons on my Calcomp digitizer puck. All of them work EXCEPT the fillet command. In previous versions of AutoCad, the following worked (for my button #5):

    [5 Fillet]*^c^c$s=x $s=fillet fillet

    This doesn't work. The comand line shows jibberish and scrolls.

    Here's the code for my button #6. IT works. I tried adding "auto" to the end of #5. No good.
    [6 trim]*^c^c$s=x $s=trim trim auto

    Can anyone help me with a direction for this problem?????
    Thanks!

Page 2 of 2 FirstFirst 12

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
  •