Joining Exploded Linetypes

kgrupenhof · ‎08-28-2020

I've struggled with this problem for years. Finally came to a head today when I have to develop contiguous polylines of a large number of utilities from a several hundred acre site.

The drawing I received contains a number of utilities drawn. All of them are lines or polylines broken by text. Where most would use a linetype, this drawing has a line, then the corresponding text, and another line. Its as if the linetypes were exploded leaving lines, polylines, and text. Example in attached picture.

I've tried several approaches, namely MPEDIT with a fuzzy tolerance set to exceed the gap left by the text. This seems to be as time consuming as joining the lines via grips and JOIN. Also explored some legacy commands (weld, glue, etc.) with little luck.

Has anyone come across this before and found a easy solution?

john.uhden · ‎08-28-2020

I remember when DCA, then Softdesk, used to do that. Maybe complex linetypes hadn't come along yet?

That's a challenge to put all the pieces back together as one, but I think it can be done, so long as none of the utilities is curved. Rather than joining the pieces at each text gap, I think I would look to create one line from start to end of each tangent.

In the meanwhile, maybe tomorrow or so, I'll make a freeware version of my PJOIN, which will at least reduce your pain.

John F. Uhden

CodeDing · ‎08-28-2020

@kgrupenhof ,

You could try to create a PDF of the area / lines, then use PDFIMPORT and try the "Infer linetypes from collinear dashes" option.. If that won't detect it, then I would probably venture to guess that what you're asking for is a HUGE undertaking to try to fix.

Best,

~DD

john.uhden · ‎08-28-2020

Until I can make what you want, here is something that will at least reduce your efforts. Pick the Values option to turn on AutoJoin and make the gap large. Then just pick adjacent line segments one by one as in pick pick pick pick done.

I think I've posted this before, but I don't think it was too popular. It's old style, but it works.

Hmmm... I can't seem to be able to attach the file. Oh well, here it is longhand...

(defun C:PJOIN ( / *error* @Anonymous |e |e1 |e2 |e3 |elev1 |elev2 |ok |cmd |hl |ans
                   |elev |ent |etyp |ucs |color |v1 |v2 |v3 |v4 |p1 |p2
                   |r |rp |n |os |d |d13 |d14 |d23 |d24 |i |n |ucsfol
                   |obsel$ |dimzin @mkpoly @rtos @Anonymous |type |obj1 |obj2 |coords1 |coords2
                   @nthmod |fuzz @putucs @delucs @values @Anonymous |closed |flag @unlock @Anonymous)
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   ;*                                                                           *
   ;*         PJOIN.LSP   by    John F. Uhden                                   *
   ;*                           2 Village Road                                  *
   ;*                           Sea Girt, NJ  08750                             *
   ;*                                                                           *
   ;* * * * * * * * * * * *  Do not delete this heading!  * * * * * * * * * * * *

   ; Program allows user to recursively join combinations of two lines, arcs,
   ;    or polylines of equal elevation simply by picking each one.
   ; Entities are entmoded if within tolerance, or the user is given the option
   ;    of filling in the gap with a straight segment if over tolerance.
   ; This was written as a work-around to AutoCAD's failure to join objects
   ;    that should but won't.
   ; v12.2 added Autojoin option.
   ; v12.3 added *error* control.
   ; v12.4 added gap tolerance choice.
   ; v12.5 corrected dimzin.
   ; v12.6 changed input format, deleted @Anonymous, added @rtos, @Anonymous,
   ;       made |auto $cv_pjauto, and added UCS focus on VIEWCTR.
   ; v12.61 added missing initget for Values 11-11-96
   ; v12.7 (10-24-97) added support for R14 LWPOLYLINEs
   ; v12.8 (08-17-98) added osmode control and use of errno; changed UCS
   ;       control to saving and deleting UCS named "$CV_PJOIN$"
   ; v12.9 (08-18-00) attempting to find why it craps out... added error message
   ;       (08-19-00) problem was LWPOLYLINE Z values within R14 Vital Lisp.
   ;                  Also added better elevation checking and option to fix.
   ;                  Also added polyline Close option.
   ;       (08-21-00) Added locked layer checking from CJOIN
   ; v15.00 (11-28-00) for R15 ... added function to lambda
   ; v15.01 (12-10-01) changed lots to use Active-X "Coordinates"
   ;        plus check for parallel with current UCS.
   ; v15.02 (07-04-02) added complex POLYLINE simplification
   ; v15.03 (09-11-03) increased the default $CV_PJTOL to 1e-6
   ; v15.04 (07-25-04) fixed weird (entsel) returning "" as reported by Dany Seymour (LGA);
   ;        changed highlighting via (command ".list") to use of (sssetfirst).
   ;        Added 2004 variable PEDITACCEPT
   ; v15.05 (10-06-04) fixed highlight issue mistakenly turned off in v15.04;
   ;        highlight needs to be on to see (sssetfirst) correctly.

   (gc)
   (prompt "\nPJOIN v15.05 (c)1994-2004, John F. Uhden, Cadlantic")

   (defun *error* (|err)
      (@reset)
      (if (wcmatch (strcase |err) "*CANCEL*,*QUIT*")
         (vl-exit-with-error "\r                                              ")
         (vl-exit-with-error (strcat "\r*ERROR*: " |err))
      )
      (princ)
   )
   (defun @Anonymous ()
      (while (> (getvar "cmdactive") 0)(command))
      (if |e3 (entdel |e3))
      (if |color (command "_.color" |color))
      (if @delucs (@delucs))
      (if (= (type |hl) 'INT)(setvar "highlight" |hl))
      (if (= (type |elev) 'REAL)(setvar "elevation" |elev))
      (if (= (type |cmd) 'INT)(setvar "cmdecho" |cmd))
      (if (= (type |dimzin) 'INT)(setvar "dimzin" |dimzin))
      (if (= (type |os) 'INT)(setvar "osmode" |os))
      (if (= (type |ucsfol) 'INT)(setvar "ucsfollow" |ucsfol))
      (vla-endundomark *doc*)
      (princ)
   )
   ;;-------------------------------------------
   ;; Initilalize drawing and program variables:
   ;;
   (setq |elev (getvar "elevation")
         |hl (getvar "highlight")
         |color (getvar "cecolor")
         |obsel$ "  Object selected is a(n) "
         |cmd (getvar "cmdecho")
         |dimzin (getvar "dimzin")
         |os (getvar "osmode")
         |rel (atoi (getvar "acadver"))
         |fuzz 0.0000000001
         |ucs "$CV_PJOIN$$"
         |ucsfol (getvar "ucsfollow")
   )
   (if (or (/= (type $cv_pjtol) 'REAL)(< $cv_pjtol 0.0))(setq $cv_pjtol 0.000001))
   (if (not (vl-position $cv_pjauto '("Yes" "No")))(setq $cv_pjauto "Yes"))

   (vl-load-com)
   (setq *doc* (vlax-get (vlax-get-acad-object) 'Activedocument)))
   (vla-endundomark *doc*)
   (vla-startundomark *doc*)
   (setvar "cmdecho" 0)
   (setvar "dimzin" 1)
   (setvar "highlight" 0)
   (setvar "osmode" 0)
   (setvar "ucsfollow" 0)

   ;;-------------------------------------------------------------------
   ;; Function for LWPOLYLINES to convert a vertex point into a 2D list:
   ;;
   (defun @Anonymous (|p)(list (car |p)(cadr |p)))
   ;;-------------------------------------------------------------------
   ;; Function to convert a vertex point into a 3D list with elevation Z:
   ;;
   (defun @Anonymous (p z)(list (car p)(cadr p) z))
   ;;------------------------------------------------------
   ;; Function to check for an entity's layer being locked:
   ;;
   (defun @unlock (|layer / |ent |flag)
      (setq |ent (entget (tblobjname "layer" |layer))
            |flag (cdr (assoc 70 |ent))
      )
      (initget "Yes No")
      (if (= 4 (logand |flag 4))
         (if (/= (getkword (strcat "\nUnlock layer " |layer "?  <Yes>/No: ")) "No")
            (entmod
               (setq |flag (boole 4 4 |flag)
                     |ent (subst (cons 70 |flag)(assoc 70 |ent) |ent)
               )
            )
         )
         1
      )
   )
   ;;-----------------------------------------------------------------------
   ;; Function to change an item at the nth position within a list of items:
   ;; Required input:
   ;;    data = data list as would be returned by (entget)
   ;;    item = value of item to modify (it's up to you)
   ;;       n = the position (counting from zero) of the item to modify
   ;; Local symbols:
   ;;       i = the index counter
   ;;     new = the new list created by modifying the item
   ;; Returns a list, which is either the same as the old list (if n is greater
   ;;    than the length of the original data list) or a new list with the item
   ;;    placed at the nth position
   ;;
   (defun @nthmod (data item n / i new)
      (setq i 0)
      (if (and (not (atom data))
               (not (atom (cdr data)))
               (= (type n) 'INT))
         (while (< i (length data))
            (if (= i n)
               (setq new (cons item new))
               (setq new (cons (nth i data) new))
            )
            (setq i (1+ i))
         )
      )
      (reverse new)
   )
   ;;-----------------------------------------------
   ;; Function to turn a non-poly into a polyline:
   ;;
   (defun @mkpoly ( / |ans)
      (if (/= (getvar "PEDITACCEPT") 1)
        (progn
          (prompt "\nObject selected is not a polyline.")
          (initget "Yes No")
          (setq |ans (getkword "\nDo you want to turn it into one?  No/<Yes>: "))
          ;(command)
        )
      )
      (sssetfirst)
      (if (/= |ans "No")
         (if (@unlock (cdr (assoc 8 |ent)))
            (progn
               (vlax-release-object |obj1)
               (if (= (getvar "PEDITACCEPT") 1)
                 (command "_.pedit" |e1 "_X")
                 (command "_.pedit" |e1 "_Y" "_X")
               )
               (setq |e1 (entlast)
                     |ent (entget |e1)
                     |obj1 (vlax-ename->vla-object |e1)
                     |type (cdr (assoc 0 |ent))
                     |elev1 (vlax-get |obj1 "Elevation")
                     |closed nil
                     |ok 1
               )
               ;(command "_.list" |e1)
               (sssetfirst (ssadd |e1))
            )
         )
      )
   )
   ;;-------------------------------------
   ;; Function to convert real to string:
   ;;
   (defun @rtos (|n)
      (strcat (rtos |n (getvar "lunits") 12)(getvar "dimpost"))
   )
   ;;------------------------------------------
   ;; Function to get the user's preferences:
   ;; (changed to function per request of Mickla 8/96)
   ;;
   (defun @values ( / |ans |prompt)
      (initget 4) ; disallow negative values
      (setq |ans
         (getdist
            (strcat "\nMaximum gap distance to automatically modify an endpoint "
                    "\nbefore joining <" (@rtos $cv_pjtol) ">: "
            )
         )
      )
      (if |ans (setq $cv_pjtol |ans))
      (if (= $cv_pjauto "Yes")
         (setq |prompt "\nAutomatically join objects separated by a gap?  <Yes>/No: ")
         (setq |prompt "\nAutomatically join objects separated by a gap?  Yes/<No>: ")
      )
      (initget "Yes No")
      (if (setq |ans (getkword |prompt))
         (setq $cv_pjauto |ans)
      )
   )
   (defun @putucs ()
      (if (and (= (type |ucs) 'STR)(tblsearch "UCS" |ucs))
         (command "_.UCS" "_S" |ucs "_Y")
         (command "_.UCS" "_S" |ucs)
      )
   )
   (defun @delucs ()
      (if (and (= (type |ucs) 'STR)(tblsearch "UCS" |ucs))
         (command "_.UCS" "_R" |ucs "_.UCS" "_D" |ucs)
      )
   )
   ;;------------------------------------
   ;; Main function to act on entities:
   ;;
   (defun @Anonymous ()
      (setq |e1 (car |e1) |ok nil)
      (@putucs)
      (command "_.UCS" "_O" (getvar "viewctr"))
      (setvar "highlight" 1)
      ;(command "_.list" |e1)
      (sssetfirst nil (ssadd |e1))
      (setq |obj1 (vlax-ename->vla-object |e1)
            |ent (entget |e1)
            |etyp (cdr (assoc 0 |ent))
      )
      (cond
         ((= |etyp "ARC")
            (if (equal (vlax-get |obj1 "Normal")(@cv_ucsdir) 1e-11)
               (@mkpoly)
               (prompt "  Object not parallel with current UCS.")
            )
         )
         ((= |etyp "LINE")
            (if (= (last (cdr (assoc 10 |ent)))
                   (last (cdr (assoc 11 |ent)))
                )
               (progn
                  (vlax-put |obj1 "Normal" (@cv_ucsdir))
                  (@mkpoly)
               )
               (prompt (strcat |obsel$ "3DLINE."))
            )
         )
         ((vl-position |etyp '("LWPOLYLINE" "POLYLINE"))
            (cond
               ((> (boole 1 8 (cdr (assoc 70 |ent))) 0)
                  (prompt (strcat |obsel$ "3DPOLY."))
               )
               ((> (boole 1 16 (cdr (assoc 70 |ent))) 0)
                  (prompt (strcat |obsel$ "3DMESH."))
               )
               ((= 1 (logand 1 (cdr (assoc 70 |ent))))
                  (setq |closed (not (prompt "  Polyline is closed.")))
               )
               ((not (equal (vlax-get |obj1 "Normal")(@cv_ucsdir) 1e-11))
                  (prompt "  Object not parallel with current UCS.")
               )
               ((not (@unlock (cdr (assoc 8 |ent)))))
               (1 (and ; added simplification (07-04-02)
                     (= |etyp "POLYLINE")
                     (/= (vla-get-type |obj1) 0)
                     (progn
                        (vlax-release-object |obj1)
                        (@cv_simplify |e1)
                        (setq |obj1 (vlax-ename->vla-object |e1))
                     )
                  )
                  (setq |coords1 (vlax-get |obj1 "Coordinates")
                        |coords1 (@cv_parse_list |coords1 (if (= |etyp "POLYLINE") 3 2))
                        |elev1 (vlax-get |obj1 "Elevation")
                        |type |etyp
                        |closed nil
                        |ok 1
                  )
               )
            )
         )
         (1 (prompt (strcat |obsel$ |etyp ".")))
      )
      (setvar "errno" 0)
      (if |ok
         (while (and (not |closed)(/= (getvar "errno") 52))
            (if (null (entget |e1))
               (setq |e1 (entlast))
            )
            (setq |obj1 (vlax-ename->vla-object |e1)
                  |type (cdr (assoc 0 (entget |e1)))
                  |elev1 (vlax-get |obj1 "Elevation")
                  |ok nil
            )
            (setq ok 0)
            (sssetfirst nil (ssadd |e1))
            (setq |e2 (entsel "\nSelect line, arc, or polyline to join: "))
            (cond
               ((not |e2))
               ((listp |e2)
                  (setq |e2 (car |e2))
                  ;(command |e2) ; add to the list command
                  (sssetfirst (ssadd |e2 (ssadd |e1)))
                  (setq |ent (entget |e2)
                        |obj2 (vlax-ename->vla-object |e2)
                        |etyp (cdr (assoc 0 |ent))
                        ok 1
                  )
               )
               (1
                  (setvar "errno" 52)
                  (setq |e2 nil ok 2)
               )
            )
            (cond
               ((not |e2))
               ((eq |e1 |e2)(prompt "  Same polyline selected."))
               ((or (= |etyp "LWPOLYLINE")(= |etyp "POLYLINE"))
                  (cond
                     ((> (boole 1 8 (cdr (assoc 70 |ent))) 0)
                        (prompt (strcat |obsel$ "3DPOLY."))
                     )
                     ((> (boole 1 16 (cdr (assoc 70 |ent))) 0)
                        (prompt (strcat |obsel$ "3DMESH."))
                     )
                     ((= 1 (logand 1 (cdr (assoc 70 |ent))))
                        (setq |closed (not (prompt "  Polyline is closed.")))
                     )
                     ((not (equal (vlax-get |obj2 "Normal")(@cv_ucsdir) 1e-11))
                        (prompt "  Object not parallel with current UCS.")
                     )
                     ((not (@unlock (cdr (assoc 8 |ent)))))
                     (1 (and ; added simplification (07-04-02)
                           (= |etyp "POLYLINE")
                           (/= (vla-get-type |obj2) 0)
                           (progn
                              (vlax-release-object |obj2)
                              (@cv_simplify |e2)
                              (setq |obj2 (vlax-ename->vla-object |e2))
                           )
                        )
                        (setq |coords2 (vlax-get |obj2 "Coordinates")
                              |coords2 (@cv_parse_list |coords2 (if (= |etyp "POLYLINE") 3 2))
                              |elev2 (vlax-get |obj2 "Elevation")
                              |v3 (@3d (car |coords2) |elev2)
                              |v4 (@3d (last |coords2) |elev2)
                              |ok 1
                        )
                     )
                  )
               )
               ((= |etyp "LINE")
                  (setq |v3 (cdr (assoc 10 |ent))
                        |v4 (cdr (assoc 11 |ent))
                        |elev2 (last |v3)
                  )
                  (if (= (last |v3)(last |v4))
                     (if (@unlock (cdr (assoc 8 |ent)))
                        (setq |ok 1)
                     )
                     (prompt (strcat |obsel$ "3DLINE."))
                  )
               )
               ((= |etyp "ARC")
                  (cond
                     ((not (equal (vlax-get |obj2 "Normal")(@cv_ucsdir) 1e-11))
                        (prompt "  Object not parallel with current UCS.")
                     )
                     ((not (@unlock (cdr (assoc 8 |ent)))))
                     (1 (setq |rp (cdr (assoc 10 |ent))
                              |r  (cdr (assoc 40 |ent))
                              |v3 (polar |rp (cdr (assoc 50 |ent)) |r)
                              |v4 (polar |rp (cdr (assoc 51 |ent)) |r)
                              |elev2 (last |v3)
                              |ok 1
                        )
                     )
                  )
               )
               (1 (prompt (strcat |obsel$ |etyp ".")))
            )
            (if (and |ok (not (equal |elev1 |elev2 |fuzz)))
               (progn
                  (prompt (strcat "\nElevations vary...  Main=" (rtos |elev1 2 4) "  Selected=" (rtos |elev2 2 4)))
                  (initget "Yes No")
                  (setq |ans (getkword "\nChange selected object?  <Yes>/No: "))
                  (if (= |ans "No")
                     (setq |ok nil)
                     (setq |v3 (@3d |v3 |elev1)
                           |v4 (@3d |v4 |elev1)
                           |ok 1
                     )
                  )
               )
            )
            (if |ok
               (progn
                  (setq |coords1 (vlax-get |obj1 "Coordinates")
                        |coords1 (@cv_parse_list |coords1 (if (= |type "POLYLINE") 3 2))
                        |v1 (@3d (car |coords1) |elev1)
                        |v2 (@3d (last |coords1) |elev1)
                        |d13 (distance |v1 |v3)
                        |d |d13
                        |p1 |v1
                        |p2 |v3
                        |d14 (distance |v1 |v4)
                        |d23 (distance |v2 |v3)
                        |d24 (distance |v2 |v4)
                        |n (1- (length |coords1))
                        |i 0
                  )
                  (if (< |d14 |d)(setq |d |d14 |p1 |v1 |p2 |v4 |i 0))
                  (if (< |d23 |d)(setq |d |d23 |p1 |v2 |p2 |v3 |i |n))
                  (if (< |d24 |d)(setq |d |d24 |p1 |v2 |p2 |v4 |i |n))
                  ;(command)
                  (sssetfirst)
                  (setvar "highlight" 0)
                  (command "_.change" |e2 "" "_P" "_E" |elev1 "")
                  (cond
                     ((< |d |fuzz)(command "_.pedit" |e1 "_J" |e2 "" "_X"))
                     ((<= |d $cv_pjtol)
                        (if (= |type "LWPOLYLINE")
                           (setq |coords1 (@nthmod |coords1 (@noz |p2) |i))
                           (setq |coords1 (@nthmod |coords1 |p2 |i))
                        )
                        (vlax-put |obj1 "coordinates" (apply 'append |coords1))
                        (command "_.pedit" |e1 "_J" |e2 "" "_X")
                     )
                     ((and (= $cv_pjauto "Yes")(> |d $cv_pjtol))
                        (setvar "highlight" 0)
                        (setvar "elevation" |elev1)
                        (setvar "osmode" 0)
                        (command "_.line" (trans |p1 0 1)(trans |p2 0 1) "")
                        (setvar "elevation" |elev)
                        (command "_.pedit" |e1 "_J" (entlast) |e2 "" "_X")
                     )
                     ((> |d $cv_pjtol)
                        (setvar "highlight" 1)
                        (setvar "elevation" |elev1)(command "_.color" "1")
                        (setvar "osmode" 0)
                        (command "_.line" (trans |p1 0 1)(trans |p2 0 1) "")
                        (setvar "elevation" |elev)
                        (command "_.color" |color)
                        (setq |e3 (entlast)) ;(command "_.list" |e1 |e2 |e3)
                        (sssetfirst nil (ssadd |e1 (ssadd |e2 (ssadd |e3))))
                        (prompt (strcat "\nPolylines miss joining by " (@rtos |d)))
                        (initget "Yes No")
                        (setq |ans (getkword "\nAdd segment and join?  No/<Yes>: "))
                        ;(command)
                        (sssetfirst)
                        (setvar "highlight" 0)
                        (if (= |ans "No")
                           (entdel |e3)
                           (command "_.pedit" |e1 "_J" (entlast) |e2 "" "_X")
                        )
                        (setq |e3 nil)
                     )
                  )
                  (vlax-release-object |obj1)
                  (vlax-release-object |obj2)
                  (if (null (entget |e1))
                     (setq |e1   (entlast)
                           |type (cdr (assoc 0 (entget |e1)))
                     )
                  )
                  (setvar "highlight" 1)
                  ;(command "_.list" |e1)
                  (sssetfirst nil (ssadd |e1))
               )
               ;(if |e2 (command "_R" |e2 "_A"))
            )
            (setq |closed (= (logand (cdr (assoc 70 (entget |e1))) 1) 1))
            (if |closed (prompt "  Polyline is closed."))
         )
         (setq |e1 nil)
      )
      (while (> (strlen (getvar "cmdnames"))(strlen (eval (vl-doc-ref '$cv_cmdname)))) (command))
      (if (and |e1 (setq |ent (entget |e1))(not |closed))
         (progn
            (setvar "highlight" 1)
            (sssetfirst (ssadd |e1))
            (initget "Yes No")
            (setq |ans (getkword "\nClose polyline?  Yes/<No>: "))
            (sssetfirst)
            (if (= |ans "Yes")
               (command "_.PEDIT" |e1 "_Cl" "_X")
            )
         )
      )
      (@delucs)
   )
   ;;=======================
   ;; Begin user action:
   ;;
   (prompt (strcat "\nDefault:  Auto-Join = " $cv_pjauto))
   (prompt (strcat "\nValues :  Maximum Auto-Join Gap = " (@rtos $cv_pjtol)))
   (initget "Values")
   (while (setq |e1 (entsel "\nValues/<Select polyline>: "))
      (cond
         ((= |e1 "Values")(@values))
         ((null |e1))
         (1 (@main))
      )
      (initget "Values")
   )
   (@reset)
)
(defun c:PJ ()(c:PJOIN))

John F. Uhden

Sea-Haven · ‎08-28-2020

Would looking for the text make it faster as this is where the break occurs just an idea, replace adjacent two lines with 1 new one.. Could do a list of text to search for. Can use ht of text and a polygon to find the two nearest *lines.

It is expected that text is always between 2 tangential segments.

John snuck post in as I was pressing send.

john.uhden · ‎08-28-2020

That's an idea. I was thinking more of looking for lines all of the same
angle, then sorting them in order of proximity to one another and then
checking if the angle from one to the next were the same.
Sheesh, with that anyone can write it. Of course it would help if each
utility were on an appropriate layer.
Then again I remember years ago when Tony Tanzillo callied me a pea brain
for some solution I posted that wasn't concise and understandable enough
for his liking. To which I replied, "Well if a pea brain can figure it
out, then I guess anyone can."

John F. Uhden

Sea-Haven · ‎08-28-2020

Having a play now super simple join to ends watch this space. Really need a true sample dwg.

dlanorh · ‎08-29-2020

@john.uhden wrote:
Then again I remember years ago when Tony Tanzillo callied me a pea brain
for some solution I posted that wasn't concise and understandable enough
for his liking.

I cannot remember TT ever using the term pea brain, and didn't realise you were also a member of the club. 😄

I am not one of the robots you're looking for

john.uhden · ‎08-29-2020

I go back to the days of Grant & Elaine, who I am wondering if they were both actually TT. I kinda figure that Tony didn't really have anyone smart enough to argue with him, so he created a way to argue with himself. I never did ask Anne Brown if that was the case. All I know is that she expelled him many times.

John F. Uhden

john.uhden · ‎08-29-2020

I think I did it.

Plus, it turns out this thing can mend lines even without any text.

It will process a whole layer full of line segments in one shot.

I'm sure that any number of the smarter folks here could make it more compact and streamlined, but if it works, who cares?

(defun c:MendLines ( / *error* vars vals OK @ss2list @angsame e layer ss lines ent ang same x1 x2 y1 y2 p1 p2 n1 n2)
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   ;*                                                                            *
   ;*         MendLines.LSP by John F. Uhden                                   *
   ;*                                              2 Village Road                                  *
   ;*                                             Sea Girt, NJ  08750                             *
   ;*                                                                            *
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

   ;; Replaces all utility lines broken with text on a selected layer
   ;; with continuous lines on the same layer.
   ;; It does not handle arcs.

   ; v1.0 (8-29-2020) as requested by @kgrupenhof

   (gc)
   (vl-load-com)
   (princ "MendLines (c)2020, John F. Uhden\n")

   (defun *error* (error)
     (mapcar 'setvar vars vals)
     (vla-endundomark *doc*)
     (cond
       ((not error))
       ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
       (1 (princ (strcat "\nERROR: " error)))
     )
     (princ)
   )
   (setq vars '(cmdecho))
   (setq vals (mapcar 'getvar vars))
   (or *acad* (setq *acad* (vlax-get-acad-object)))
   (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
   (vla-endundomark *doc*)
   (vla-startundomark *doc*)
   (mapcar 'setvar vars '(0))
   (command "_.expert" (getvar "expert")) ;; dummy command

   (defun @ss2list (ss / i items)
     (repeat (setq i (sslength ss))
       (setq items (cons (ssname ss (setq i (1- i))) items))
     )
   )
   (defun @angsame (e p ang / ent p10 p11)
     (setq ent (entget e)
                p10 (cdr (assoc 10 ent))
                p11 (cdr (assoc 11 ent))
     )
     (and
       (equal (angle p10 p11) ang 0.0001)
       (or
         (equal (angle p p10) ang 0.0001)
         (equal (angle p p11) ang 0.0001)
         (equal (angle p10 p) ang 0.0001)
         (equal (angle p11 p) ang 0.0001)
       )
     )
   )
   ;;--------------------------------------------------------------------
   (while (not ok)
     (and
       (setq e (car (entsel "\nSelect line on layer to process: ")))
       (setq layer (cdr (assoc 8 (entget e))))
       (setq ok 1)
     )
   )
   (setq ss (ssget "X" (list '(0 . "LINE")(cons 8 layer)(cons 410 (getvar "ctab")))))
   (setq lines (@ss2list ss))
   (setq n1 (length lines) n2 0)
   (while (and lines (> n1 1))
     (setq e (car lines)
                ent (entget e)
                ang (angle (setq p (cdr (assoc 10 ent)))(cdr (assoc 11 ent)))
                same (vl-remove-if-not '(lambda (e) (@angsame e p ang)) lines)
                x1 (apply 'min (mapcar '(lambda (e)(cadr (assoc 10 (entget e)))) same))
                x2 (apply 'max (mapcar '(lambda (e)(cadr (assoc 10 (entget e)))) same))
                y1 (apply 'min (mapcar '(lambda (e)(caddr (assoc 10 (entget e)))) same))
                y2 (apply 'max (mapcar '(lambda (e)(caddr (assoc 10 (entget e)))) same))
     )
     (cond
       ((<= 0 ang (* 0.5 pi))
         (setq p1 (list x1 y1)
                    p2 (list x2 y2)
         )
       )
       ((<= (* 0.5 pi) ang pi)
         (setq p1 (list x2 y1)
                    p2 (list x1 y2)
         )
       )
       ((<= pi ang (* 1.5 pi))
         (setq p1 (list x2 y2)
                    p2 (list x1 y1)
         )
       )
       ((<= (* 1.5 pi) ang (* 2 pi))
         (setq p1 (list x1 y2)
                    p2 (list x2 y1)
         )
       )
     )
     (and
       (> (length same) 1)
       (or (mapcar 'entdel same) 1)
       (if (setq ss (ssget "F" (list p1 p2) (list '(0 . "TEXT")(cons 8 layer))))
         (vl-cmdf "_.erase" ss "")
         1
       )
       (entmake (list '(0 . "LINE")(cons 8 layer)(cons 10 p1)(cons 11 p2)))
       (setq n2 (1+ n2))
     )
     (foreach item same (setq lines (vl-remove item lines)))
   )
   (if (> n2 1)
     (prompt (strcat "\nReplaced " (rtos n1 2 0) " line segments with " (rtos n2 2 0) " whole line(s)."))
     (prompt "\nDid not replace any lines.")
   )
   (*error* nil)
)

John F. Uhden

Sea-Haven · ‎08-30-2020

This has a bug in it but sort of works have to do some real work will fix the last line problem later, Uses a look for text method. Was thinking make into pline once joined. Then use like John remove same angle vertices.

As it uses text could delete text adding correct linetype for layer etc.

(defun ah:swap ( / d1 d2)
(setq d1 (distance pt1 pt3))
(setq d2 (distance pt2 pt3))
(if (> d1 d2)
  (progn 
    (setq temp pt1)
    (setq pt1 pt2)
    (setq pt2 temp)
  )
)
)

(defun c:test ( / )
(setq ent (entget (car (entsel "\nPick text"))))
(setq txt (cdr (assoc 1 ent)))
(setq lay (cdr (assoc 8 ent)))
(setq ht (cdr (assoc 40 ent)))
(setq ss (ssget (list (cons 0 "Text")(cons 8 lay)(cons 1 txt))))
(repeat (setq x (sslength ss))
(setq ent (entget (ssname ss (setq x (- x 1)))))
(setq pt3 (cdr (assoc 10 ent)))
(setq rad (* ht 1.5))
(command "polygon" 10 tins rad)
(setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(setq ss2 (ssget "f" lst))
(if (>= (sslength ss2) 2)
(progn
(setq ent1 (vlax-ename->vla-object (ssname ss2 1)))
(setq ent2 (vlax-ename->vla-object (ssname ss2 2)))
(setq pt2 (vlax-curve-getendpoint ent1))
(setq pt1 (vlax-curve-getstartpoint ent1))
(ah:swap)
(setq start1 pt1 end1 pt2)
(setq pt2 (vlax-curve-getendpoint ent2))
(setq pt1 (vlax-curve-getstartpoint ent2))
(ah:swap)
(vla-put-startpoint ent2 (vlax-3d-point end1))
)
(progn (alert "missed 2 lines")(exit))
)
)
(princ)
)
(c:test)

Sea-Haven · ‎08-30-2020

Please ignore prior post in correct version posted, just select a text then select a larger group. Without a dwg to test on only a simple version at this stage.

; remove text in between lines 
; By AlanH Aug 2020 info@alanh.com.au


(defun ah:swap ( / d1 d2)
(setq d1 (distance pt1 pt3))
(setq d2 (distance pt2 pt3))
(if (> d1 d2)
  (progn 
    (setq temp pt1)
    (setq pt1 pt2)
    (setq pt2 temp)
  )
)
)

(defun c:test ( / oldsnap )
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq ent (entget (car (entsel "\nPick text"))))
(setq txt (cdr (assoc 1 ent)))
(setq lay (cdr (assoc 8 ent)))
(setq ht (cdr (assoc 40 ent)))
(princ "\nSelect all text"))
(setq ss (ssget (list (cons 0 "Text")(cons 8 lay)(cons 1 txt))))
(repeat (setq x (sslength ss))
(setq ent (entget (ssname ss (setq x (- x 1)))))
(setq pt3 (cdr (assoc 10 ent)))
(setq rad (* ht 2.0))
(command "polygon" 10 pt3 rad)
(setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(setq ss2 (ssget "f" lst))
(command "erase" (entlast) "")
(if (>= (sslength ss2) 2)
(progn
(setq ent1 (vlax-ename->vla-object (ssname ss2 1)))
(setq ent2 (vlax-ename->vla-object (ssname ss2 2)))
(setq pt2 (vlax-curve-getendpoint ent1))
(setq pt1 (vlax-curve-getstartpoint ent1))
(ah:swap)
(setq start1 pt1 end1 pt2)
(setq pt2 (vlax-curve-getendpoint ent2))
(setq pt1 (vlax-curve-getstartpoint ent2))
(ah:swap)
(vla-put-startpoint ent1 (vlax-3d-point pt1))
)
(progn (alert "missed 2 lines")(exit))
)
)
(setvar 'osmode oldsnap)
(princ)
)
(c:test)

*EXISTING_GAS_MAIN,Existing Gas main - - -G- - -G- - -G- - -G- - -
A,5.08,-5.08,5.08,-5.08,["G",STANDARD,S=1.8,R=0.0,X=-1.8,Y=-.9],-3

kgrupenhof · ‎08-31-2020

John - I ran your LISP this morning. It appears to work for the most part (screenshot below). I'm guessing the linework was more complex that anyone anticipated. In the screenshot below the pink/magenta is the "mended" linework and the yellow is the original. You can see it mended most of the gaps but also, for some reason, deleted large chunks. This is lightyears better, actually, than what I had to deal with. Trying sea.haven's next...

kgrupenhof · ‎08-31-2020

sea.haven - I cannot get your's to run. I loaded it and ran "test" - is that correct? I saw ah:swap in the code but this isn't a user command is it?

Sorry for my ignorance. Not extremely adept at LISP even though I've written a few basic ones!

Also, I saw mention of needing a sample of the linework - please see the attached drawing.

And a great thank you to everyone here who has been willing to lend a hand. I've seen this exact issue a number of times over the last eight years, so I wager there are many others out there who can/will benefit from the work and discussion you all have provided.

john.uhden · ‎08-31-2020

@kgrupenhof :

I tested your Sample_Linework.dwg. I set the current entity color, CECOLOR, to magenta so I could easily see the changes.

Though it did a lot, MendLines did not mend everything.

I undid and increased the angular fuzz factor in the program and loaded and ran it again. It did a better job of mending, which means that some apparently straight tangents contain segments that are not exactly collinear. Also bear in mind that if the program does not find more than one collinear lines, then it will leave the singular one alone.

I am concerned that increasing the fuzz factor too much will do mending that shouldn't be done and modify your drawing improperly.

Perhaps it would be better to increase the fuzz factor but join the segments into a lightweight polyline by filling in the gaps. That could be a lot more code and processing time, but each original segment will be left in place. I think a lightweight polyline with many vertices is a lot less data than as many separate lines. Then again, since I think you are trying only to clean up utilities, I doubt that shifting a vertex by a tiny amount means anything.* As to connecting adjacent lines at different angles, I don't think I will spend the time to do that, but you could use the PJOIN I posted, which allows you to decide what should be joined to what.

I'll think about it. In the meanwhile, I think the MendLines.lsp I posted at least reduces your labor immensely.

I think I'll change the reporting at the end to indicate the net reduction in line segments and the percentage of the total. Do you want to know the number of text objects deleted?

* Around my region, markouts of existing utilities are approximate at best, and proposed utilities are drawn by eye. There is no accuracy. The plans always have notes requiring the contractor to verify the location of utilities, even by hand digging.

John F. Uhden

kgrupenhof · ‎08-31-2020

John - you're correct, it isn't the end-all solution but it cuts down the amount of work considerably. Its odd to me that some of the text on the lines appear at or near vertices (resulting in the non-collinear segments you described). Judging by the layer control in this drawing, I can't say I'm surprised.

I think mendlines.lsp in conjunction with using the fuzz distance in the MPEDIT command will get me where I need to be. We're simply trying to create some linework for a large scale GIS map, so accuracy is not a concern.

john.uhden · ‎08-31-2020

Since I'm pretty sure those broken linetypes came from using Softdesk (and
maybe even Land Desktop), each line segment and text was computed
separately, perhaps with some lack of precision. I doubt that the text
location has anything to do with affecting the lines, other than requiring
the breaks.
Ya know, I'm so used to using my own programs that I don't think I've ever
used MPEDIT. It's good that you are comfortable with it.
I had an office roommate once who was a GIS wizard. She moved on to work
for Princeton University and then joined a national surveying company. We
had fun because for whatever her ARCGIS couldn't do, I would write her an
AutoLisp routine. We still converse from time to time.

John F. Uhden

john.uhden · ‎08-31-2020

@kgrupenhof :

I improved the reporting and increased the angular fuzz factor, but will most likely not undertake the other steps I had mentioned.

Here's the latest:

(defun c:MendLines ( / *error* vars vals OK @ss2list @angsame e layer ss lines ent ang same x1 x2 y1 y2 p1 p2 n1 n2 n3 n4)
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   ;*                                                                            *
   ;*         MendLines.LSP by John F. Uhden                                   *
   ;*                                              2 Village Road                                  *
   ;*                                             Sea Girt, NJ  08750                             *
   ;*                                                                            *
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

   ;; Replaces all utility lines broken with text on a selected layer
   ;; with continuous lines on the same layer.
   ;; It does not handle arcs.

   ; v1.0 (8-29-2020) as requested by @kgrupenhof
   ; v1.01 (8-31-2020) improved reporting and increased angular fuzz factor

   (gc)
   (vl-load-com)
   (princ "MendLines v1.01 (c)2020, John F. Uhden\n")

   (defun *error* (error)
     (mapcar 'setvar vars vals)
     (vla-endundomark *doc*)
     (cond
       ((not error))
       ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
       (1 (princ (strcat "\nERROR: " error)))
     )
     (princ)
   )
   (setq vars '(cmdecho))
   (setq vals (mapcar 'getvar vars))
   (or *acad* (setq *acad* (vlax-get-acad-object)))
   (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
   (vla-endundomark *doc*)
   (vla-startundomark *doc*)
   (mapcar 'setvar vars '(0))
   (command "_.expert" (getvar "expert")) ;; dummy command

   (defun @ss2list (ss / i items)
     (repeat (setq i (sslength ss))
       (setq items (cons (ssname ss (setq i (1- i))) items))
     )
   )
   (defun @angsame (e p ang / ent p10 p11)
     (setq ent (entget e)
                p10 (cdr (assoc 10 ent))
                p11 (cdr (assoc 11 ent))
     )
     (and
       (equal (angle p10 p11) ang 0.001)
       (or
         (equal (angle p p10) ang 0.001)
         (equal (angle p p11) ang 0.001)
         (equal (angle p10 p) ang 0.001)
         (equal (angle p11 p) ang 0.001)
       )
     )
   )
   ;;--------------------------------------------------------------------
   (graphscr)
   (while (not ok)
     (and
       (setq e (car (entsel "\nSelect line on layer to process: ")))
       (setq layer (cdr (assoc 8 (entget e))))
       (setq ok 1)
     )
   )
   (princ (strcat "\nProcessing layer:  " layer " ...\n"))
   (setq ss (ssget "X" (list '(0 . "LINE")(cons 8 layer)(cons 410 (getvar "ctab")))))
   (setq lines (@ss2list ss))
   (setq n1 (length lines) n2 0 n3 0 n4 0)
   (while (and lines (> n1 1))
     (setq e (car lines)
                ent (entget e)
                ang (angle (setq p (cdr (assoc 10 ent)))(cdr (assoc 11 ent)))
                same (vl-remove-if-not '(lambda (e) (@angsame e p ang)) lines)
                x1 (apply 'min (mapcar '(lambda (e)(cadr (assoc 10 (entget e)))) same))
                x2 (apply 'max (mapcar '(lambda (e)(cadr (assoc 10 (entget e)))) same))
                y1 (apply 'min (mapcar '(lambda (e)(caddr (assoc 10 (entget e)))) same))
                y2 (apply 'max (mapcar '(lambda (e)(caddr (assoc 10 (entget e)))) same))
     )
     (cond
       ((<= 0 ang (* 0.5 pi))
         (setq p1 (list x1 y1)
                    p2 (list x2 y2)
         )
       )
       ((<= (* 0.5 pi) ang pi)
         (setq p1 (list x2 y1)
                    p2 (list x1 y2)
         )
       )
       ((<= pi ang (* 1.5 pi))
         (setq p1 (list x2 y2)
                    p2 (list x1 y1)
         )
       )
       ((<= (* 1.5 pi) ang (* 2 pi))
         (setq p1 (list x1 y2)
                    p2 (list x2 y1)
         )
       )
     )
     (and
       (> (length same) 1)
       (setq n3 (+ n3 (length same)))
       (or (mapcar 'entdel same) 1)
       (if (setq ss (ssget "F" (list p1 p2) (list '(0 . "TEXT")(cons 8 layer))))
         (progn
           (setq n4 (+ n4 (sslength ss)))
           (vl-cmdf "_.erase" ss "")
         )
         1
       )
       (entmake (list '(0 . "LINE")(cons 8 layer)(cons 10 p1)(cons 11 p2)))
       (setq n2 (1+ n2))
     )
     (foreach item same (setq lines (vl-remove item lines)))
   )
   (if (> n2 1)
     (progn
       (textscr)
       (prompt (strcat "\nProcessed " (rtos n1 2 0) " lines on layer " layer "."))
       (prompt (strcat "\nReplaced " (rtos n3 2 0) " line segments with " (rtos n2 2 0) " whole line(s)."))
       (prompt (strcat "\n" (rtos (- n1 n3) 2 0) " lines were not effected."))
       (prompt (strcat "\nDeleted " (rtos n4 2 0) " text entities."))
     )
     (prompt "\nDid not replace any lines.")
   )
   (*error* nil)
)

John F. Uhden

Sea-Haven · ‎08-31-2020

Unfortunately Bricscad and Autocad use two different methods of polygon and yes does not work in Autocad as falls over on Polygon command. Will add a check for which. Will post again soon s have real dwg now.

Some of the comments by John also need to be taken into account text near an end of line, in your dwg some text has not broken the lines, I look for this and now skip properly other things not working compared to my created test dwgs. Will play some more.

Fixed a couple of problems now found a couple more the line and text is not consistent the gaps vary I use a guess to find the 2 adjacent lines and it does sometimes miss. But will keep trying to do as much as possible.

Found another hitting nearby objects using my method will change shape to stop this. May look at changing layer of lines to fix this.

john.uhden · ‎08-31-2020

Umm, what does the Polygon command have to do with this?
Are things warming up down there a bit these days?
The weather here has been beautiful for the past few days.

John F. Uhden

Community

Joining Exploded Linetypes

Joining Exploded Linetypes

Joining Exploded Linetypes