Page 1 of 3 123 LastLast
Results 1 to 10 of 22

Thread: Lisp to locate lines that are not touching

  1. #1
    Member
    Join Date
    2013-02
    Posts
    18
    Login to Give a bone
    0

    Default Lisp to locate lines that are not touching

    Hi,


    I would like to know whether there is a lisp that clearly identifies lines which do not join in a drawing as well as lines that cross. As I have over 3000 lines i am find it hard to do this manually using the trim command.
    Basically i need the lines to join at the intersections.

    PLease let me know if i dont make sense.
    Thanks!

  2. #2
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL
    Posts
    3,397
    Login to Give a bone
    0

    Default Re: Lisp to locate lines that are not touching

    AutoCAD Command:
    pedit => Join => Jointype => Extend => Enter fuzz distance (how far apart the endpoints can be and still be joined.)
    Lisp routine:
    Code:
     ;;; PLJOIN.LSP 2011 Version
    ;;; Joins lines, arcs and polylines
    ;;; If only one object is selected it joins to all conected objects
    ;;; If multiple objects are selected it joins to all conected objects using entered fuzz distance.
    ;;; By Tom Beauford
    ;;; BeaufordT@LeonCountyFL.gov
    ;;; Macro   ^P(or C:pljoin (load "pljoin.lsp"));pljoin
    
    (defun c:pljoin (/ cmdecho peditaccept ss fuzzdst)
      (princ "\nSelect object to join: ")
      (setq cmdecho (getvar "cmdecho")
            peditaccept (getvar "peditaccept")
            ss (ssget '((0 . "LINE,ARC,*POLYLINE")))
            fuzzdst (getdist "\nFuzz Distance: ")
      )
      (setvar "cmdecho" 0)
      (setvar "peditaccept" 1)
      (if ss
          (progn
    	(if (= (sslength ss) 1)
              (command "_.pedit" ss "_J" "_all" "" "")
              (command "_.pedit" "_M" ss "" "_J" "_J" "_E" fuzzdst "")
    ;          (command "_.pedit" "_M" ss "" "_J" "_J" "_E" "0.0" "")
    	)
          )
      )
      (setvar "cmdecho" cmdecho)
      (setvar "peditaccept" peditaccept)
      (princ)
    )
    You can select all first then run pljoin.
    Tom Beauford P.S.M. - Civil 2020 on Windows 10 Enterprise
    Design Analysis - Leon County Public Works/Engineering Wrap [CODE] tags around selected text
    2280 Miccosukee Rd. Tallahassee, FL 32308-5310
    Ph# (850)606-1516 Home Page

  3. #3
    Member
    Join Date
    2013-02
    Posts
    18
    Login to Give a bone
    0

    Default Re: Lisp to locate lines that are not touching

    Quote Originally Posted by Tom Beauford View Post
    AutoCAD Command:
    pedit => Join => Jointype => Extend => Enter fuzz distance (how far apart the endpoints can be and still be joined.)
    Lisp routine:
    Code:
     ;;; PLJOIN.LSP 2011 Version
    ;;; Joins lines, arcs and polylines
    ;;; If only one object is selected it joins to all conected objects
    ;;; If multiple objects are selected it joins to all conected objects using entered fuzz distance.
    ;;; By Tom Beauford
    ;;; BeaufordT@LeonCountyFL.gov
    ;;; Macro   ^P(or C:pljoin (load "pljoin.lsp"));pljoin
    
    (defun c:pljoin (/ cmdecho peditaccept ss fuzzdst)
      (princ "\nSelect object to join: ")
      (setq cmdecho (getvar "cmdecho")
            peditaccept (getvar "peditaccept")
            ss (ssget '((0 . "LINE,ARC,*POLYLINE")))
            fuzzdst (getdist "\nFuzz Distance: ")
      )
      (setvar "cmdecho" 0)
      (setvar "peditaccept" 1)
      (if ss
          (progn
    	(if (= (sslength ss) 1)
              (command "_.pedit" ss "_J" "_all" "" "")
              (command "_.pedit" "_M" ss "" "_J" "_J" "_E" fuzzdst "")
    ;          (command "_.pedit" "_M" ss "" "_J" "_J" "_E" "0.0" "")
    	)
          )
      )
      (setvar "cmdecho" cmdecho)
      (setvar "peditaccept" peditaccept)
      (princ)
    )
    You can select all first then run pljoin.
    Thanks. For some reason, the lisp doesnt work how i want it to. Is there a lisp that can put a circle around the sections which do not touch as well as lines that cross one another?

  4. #4
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL
    Posts
    3,397
    Login to Give a bone
    0

    Default Re: Lisp to locate lines that are not touching

    Could you attach a small drawing with 10 lines that do not join as well as some that cross. Copy and modify them in the drawing how you would like them to end up. I thought the code above would work, I may not understand what you're looking for. No lines in a drawing join with all other lines. You want to identify all the end points and intersections in a drawing?
    Tom Beauford P.S.M. - Civil 2020 on Windows 10 Enterprise
    Design Analysis - Leon County Public Works/Engineering Wrap [CODE] tags around selected text
    2280 Miccosukee Rd. Tallahassee, FL 32308-5310
    Ph# (850)606-1516 Home Page

  5. #5
    Member
    Join Date
    2013-02
    Posts
    18
    Login to Give a bone
    0

    Lightbulb Re: Lisp to locate lines that are not touching

    Quote Originally Posted by Tom Beauford View Post
    Could you attach a small drawing with 10 lines that do not join as well as some that cross. Copy and modify them in the drawing how you would like them to end up. I thought the code above would work, I may not understand what you're looking for. No lines in a drawing join with all other lines. You want to identify all the end points and intersections in a drawing?
    Hi Tom, If you have a look at the attachment, I basically want to highlight the areas where the yellow lines cross and do not cross the red/purple lines so I can adjust them to either extend or trim the line back.
    Attached Files Attached Files

  6. #6
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL
    Posts
    3,397
    Login to Give a bone
    0

    Default Re: Lisp to locate lines that are not touching

    Quote Originally Posted by Zali001 View Post
    Hi Tom, If you have a look at the attachment, I basically want to highlight the areas where the yellow lines cross and do not cross the red/purple lines so I can adjust them to either extend or trim the line back.
    Take a look at this routine: http://lispcad.com/2012/05/autolisp-...-extend-lines/
    Tom Beauford P.S.M. - Civil 2020 on Windows 10 Enterprise
    Design Analysis - Leon County Public Works/Engineering Wrap [CODE] tags around selected text
    2280 Miccosukee Rd. Tallahassee, FL 32308-5310
    Ph# (850)606-1516 Home Page

  7. #7
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL
    Posts
    3,397
    Login to Give a bone
    0

    Default Re: Lisp to locate lines that are not touching

    Modified so the trimed lines can be line or polyline. Seems to work on your drawing.
    Code:
     ;| Touch.LSP
     http://lispcad.com/2012/05/autolisp-auto-trim-and-extend-lines/
     Small routine to align endpoints of lines to an edge.
     The edge has to be a line or polyline.
     The routine works by calculating the point of inter-section and change the nearest endpoint to that point
     2001 Stig Madsen, no rights reserved
     modified by qjchen, the edge line can be line or polyline
     modified by Tom Beauford, the trimed lines can be line or polyline
     (load "Poly.lsp") Touch *
    ;GREAT for PROJECTING LINES FOR ELEVATIONS !!!!!!!!!!!
    |;
    (defun C:Touch (/ cmd ent entl spt ept sset a lent lentl lspt lept lint)
      (vl-load-com)
      (setq cmd (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (command "UNDO" "Begin")
      (while (not ent)
        (setq ent (car (entsel "Select edge line: ")))
        (if ent
          (progn
    	(setq entl (entget ent))
          )
        )
      )
      (if ent
        (progn
          (redraw ent 3)
          (prompt "nSelect lines to touch edge: ")
          (setq sset (ssget '((0 . "LINE,LWPOLYLINE")))
    	    a 0
          )
          (if sset
    	(repeat (sslength sset)
    	  (setq lentl (entget (setq lent (ssname sset a)))
    		lspt (cdr (assoc 10 lentl))
    		etype (cdr (assoc 0 lentl))
    	  )
    	  (cond
    	      ((= etype "LINE")(setq lept (cdr (assoc 11 lentl))))
    	      ((= etype "LWPOLYLINE")(setq lept (cdr (assoc 10 (reverse lentl)))))
    	      (T (princ "\nWhat?"))
    	  )
    	  (setq entttt (ssname sset a))
    	  (setq lint (nth 0 (x_intlst ent entttt acExtendOtherEntity)))
    	  (if lint
    	    (progn
    	      (if (< (distance lint lspt) (distance lint lept))
    		(setq lentl (subst(cons 10 lint)(assoc 10 lentl) lentl))
    		(cond
    		    ((= etype "LINE")(setq lentl (subst(cons 11 lint)(assoc 11 lentl) lentl)))
    		    ((= etype "LWPOLYLINE")
    			(setq lint (list (car lint) (cadr lint))
    			    lentl (reverse lentl)
    			    lentl (subst(cons 10 lint)(assoc 10 lentl) lentl)
    			    lentl (reverse lentl)
    			)
    		    )
    		)
    	      )
    	      (entmod lentl)
    	    )
    	  )
    	  (setq a (1+ a))
    	)
    	(princ "nNo objects found")
          )
          (redraw ent 4)
        )
        (princ "nNo edge selected")
      )
      (setvar "CMDECHO" cmd)
      (command "UNDO" "End")
      (princ)
    )
    
    ;;; by kuangdao at xdcad
    (defun x_intlst (obj1 obj2 param / intlst1 intlst2 ptlst)
    
      (if (= 'ENAME (type obj1))
        (setq obj1 (vlax-ename->vla-object obj1))
      )
      (if (= 'ENAME (type obj2))
        (setq obj2 (vlax-ename->vla-object obj2))
      )
      (setq intlst1 (vlax-variant-value (vla-intersectwith obj1 obj2 param)))
      (if (< 0 (vlax-safearray-get-u-bound intlst1 1))
        (progn
          (setq intlst2 (vlax-safearray->list intlst1))
          (while (> (length intlst2) 0)
    	(setq ptlst (cons (list (car intlst2) (cadr intlst2) (caddr intlst2))
    			  ptlst
    		    )
    	      intlst2 (cdddr intlst2)
    	)
          )
        )
      )
      ptlst
    )
    Tom Beauford P.S.M. - Civil 2020 on Windows 10 Enterprise
    Design Analysis - Leon County Public Works/Engineering Wrap [CODE] tags around selected text
    2280 Miccosukee Rd. Tallahassee, FL 32308-5310
    Ph# (850)606-1516 Home Page

  8. #8
    Member
    Join Date
    2013-02
    Posts
    18
    Login to Give a bone
    0

    Default Re: Lisp to locate lines that are not touching

    Is there a lisp that will let me label lines and polylines with the following text Diameter symbol, size of pipe, material and length in brackets. for example ∅PE 125mm (150.0m) above the lines that I selecT?

  9. #9
    AUGI Addict fixo's Avatar
    Join Date
    2005-05
    Location
    Pietari, Venäjä
    Posts
    1,269
    Login to Give a bone
    0

    Default Re: Lisp to locate lines that are not touching

    Try this code, not mine
    Code:
    ;;		borrowed from Lee Mac		;;
    ;; slightly edited  
    (defun C:PLD ( / *error* ang entity norm osm point txtstr)
    
      (vl-load-com)
      (defun *error*(msg)
        (and osm (setvar 'osmode osm))
        (if msg (princ (strcat "\n" msg)))
        (princ)
        )
      (setq osm (getvar 'osmode))
      (setvar 'osmode 16386)
      (setq txtstr "%%CPE 125mm (150.0m)")
      (while
        (and (setq entity (entsel))
          (not
            (vl-catch-all-error-p
              (setq point
                (vl-catch-all-apply 'vlax-curve-getclosestpointto
                  (list (car entity) (trans (cadr entity) 1 0))
                )
              )
            )
          )
        )
        (setq entity (car entity)
              norm   (trans '(0. 0. 1.) 1 0 t)
        )
        (setq ang
          (angle '(0. 0. 0.)
            (trans
              (vlax-curve-getfirstderiv entity
                (vlax-curve-getparamatpoint entity point)
              )
              0 norm
            )
          )
        )
        (if (and (< (/ pi 2.) ang) (<= ang (/ (* 3. pi) 2.)))
          (setq ang (- ang pi))
        )
        (setq point (trans point 0 norm))
    
            (entmakex
              (list
                (cons 0 "TEXT")
                (cons 7  (getvar 'TEXTSTYLE))
                (cons 40 (getvar 'TEXTSIZE))
                (cons 10 point)
                (cons 11 point)
                (cons 1 txtstr)
                (cons 50 ang)
    	    (cons 71 0)
                (cons 72 1)
                (cons 73 1)
                (cons 210 norm)
              )
            )
      )
    
      (princ)
    )
    "The whole problem with the world is that fools and fanatics are always
    so certain of themselves, and wiser people so full of doubts."
    Bertrand Russell

  10. #10
    Member
    Join Date
    2013-02
    Posts
    18
    Login to Give a bone
    0

    Default Re: Lisp to locate lines that are not touching

    Thanks.
    Is it possible for the lisp to label the actual length of the line that i choose (similar to the INTLEN.lsp) and can it give me options for the pipe size? Or can it label the size based on the layer that I use.



    Quote Originally Posted by fixo View Post
    Try this code, not mine
    Code:
    ;;        borrowed from Lee Mac        ;;
    ;; slightly edited  
    (defun C:PLD ( / *error* ang entity norm osm point txtstr)
    
      (vl-load-com)
      (defun *error*(msg)
        (and osm (setvar 'osmode osm))
        (if msg (princ (strcat "\n" msg)))
        (princ)
        )
      (setq osm (getvar 'osmode))
      (setvar 'osmode 16386)
      (setq txtstr "%%CPE 125mm (150.0m)")
      (while
        (and (setq entity (entsel))
          (not
            (vl-catch-all-error-p
              (setq point
                (vl-catch-all-apply 'vlax-curve-getclosestpointto
                  (list (car entity) (trans (cadr entity) 1 0))
                )
              )
            )
          )
        )
        (setq entity (car entity)
              norm   (trans '(0. 0. 1.) 1 0 t)
        )
        (setq ang
          (angle '(0. 0. 0.)
            (trans
              (vlax-curve-getfirstderiv entity
                (vlax-curve-getparamatpoint entity point)
              )
              0 norm
            )
          )
        )
        (if (and (< (/ pi 2.) ang) (<= ang (/ (* 3. pi) 2.)))
          (setq ang (- ang pi))
        )
        (setq point (trans point 0 norm))
    
            (entmakex
              (list
                (cons 0 "TEXT")
                (cons 7  (getvar 'TEXTSTYLE))
                (cons 40 (getvar 'TEXTSIZE))
                (cons 10 point)
                (cons 11 point)
                (cons 1 txtstr)
                (cons 50 ang)
            (cons 71 0)
                (cons 72 1)
                (cons 73 1)
                (cons 210 norm)
              )
            )
      )
    
      (princ)
    )

Page 1 of 3 123 LastLast

Similar Threads

  1. Replies: 1
    Last Post: 2012-08-02, 02:39 PM
  2. Select entities without touching them
    By autocad.wishlist1734 in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2005-10-05, 12:22 PM
  3. Joining non touching Polylines
    By rossi in forum AutoCAD General
    Replies: 7
    Last Post: 2005-06-06, 08:45 PM

Tags for this Thread

Posting Permissions

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