Topic: Line-consolidating routine - Flow problem?

[ANA]

Can someone tell me why this routine only processes 4 or less adjacent co-linear lines, and why it always quits on error no matter how many lines it processes?

And in general, is this the wrong way to go about it, with 3 levels of sub-routines? It's the only way I could think of to process a selection set that keeps getting changed by the processing. I've never tried anything like this before.

I work in BricsCad (Intellicad), but this routine only uses really basic functions, so I don't think that makes any difference.

Code: [Select]

;;; CleanUp converts all co-linear sets of adjacent lines into single line entities.
;;; -------------------------------------------------------------------------------------------------------------
;;; If any two lines have the same slope and an endpoint in common,
;;; they're replaced by a single line,
;;; whose endpoints are the non-matching endpoints of the first two.
;;; That's repeated until no more matches are found.
;;; -------------------------------------------------------------------------------------------------------------
;;; Flag1 means a match was found and 2 lines were replaced by a new one,
;;;    i.e., start processing the selection set all over again.
;;; The new set is processed unless it's the same length as the last set (i.e. no matches found)
;;; To process a set, pick an Ent1 against which to compare all other lines in the set,
;;;    cycling through the set with counter n1 so every line gets a chance to be Ent1.
;;; To process an Ent1, pick an Ent2 against which to compare its slope and endpoints,
;;;    cycling through the set with counter n2 so every line gets compared to Ent1.
;;; To process an Ent2, first compare its slope against M, the slope of Ent1
;;;    If there's a match, see if either of its endpoints is the same as either endpoint of Ent1
;;;    If any match, create Ent3 using the non-matching endpoints of Ent1 & Ent2,
;;;    Delete Ent1 & Ent2, create Ent3 and add it to the selection set, and set Flag1.
;;; -------------------------------------------------------------------------------------------------------------

(defun c:CleanUp ()
(sssetfirst nil nil)
(setq ss1 (ssget (list (cons 0 "LINE"))))
(setq LenSS (sslength ss1))
(setq LenSSLast 0)
(setq Tol 0.00000000000001)  ;set tolerance for matching slopes
(while (/= LenSS LenSSLast)
       (setq LenSSLast LenSS)
       (setq Flag1 0)
       (ProcSet)             ;call sub-routine
       (setq LenSS (sslength ss1))
       );while
(sssetfirst nil ss1)
);defun

;;; --------- sub-routine
(defun ProcSet ()
(setq n1 -1)
(while (= Flag1 0)
       (ProcNextEnt1)       ;call sub-routine
       );while
);defun

;;; --------- sub-sub-routine
(defun ProcNextEnt1 ()
(setq n1 (+ n1 1))
(setq Ent1 (ssname ss1 n1))
(setq Ent1data (entget Ent1))
(setq e1p1 (cdr (assoc 10 Ent1data)))
(setq e1p2 (cdr (assoc 11 Ent1data)))
(setq M (angle e1p1 e1p2))
(setq n2 -1)
(while (= Flag1 0)
       (ProcNextEnt2)       ;call sub-routine
       );while
);defun

;;; --------- sub-sub-sub-routine
(defun ProcNextEnt2 ()
(setq n2 (+ n2 1))
(setq Ent2 (ssname ss1 n2))
(setq Ent2data (entget Ent2))
(setq e2p1 (cdr (assoc 10 Ent2data)))
(setq e2p2 (cdr (assoc 11 Ent2data)))
(if (/= n1 n2)
 (if (/= n2 sslength ss1)
  (if (OR (equal M (angle e2p1 e2p2) Tol)
          (equal M (angle e2p2 e2p1) Tol))
    (progn
      (setq  e3p1 nil   e3p2 nil)
      (if (equal e1p2 e2p1) (setq e3p1 e1p1   e3p2 e2p2))
      (if (equal e1p2 e2p2) (setq e3p1 e1p1   e3p2 e2p1))
      (if (equal e1p1 e2p2) (setq e3p1 e2p1   e3p2 e1p2))
      (if (equal e1p1 e2p1) (setq e3p1 e2p2   e3p2 e1p2))
      (if (equal e3p1 nil) (nil)
        (progn
          (entmake (list '(0 . "LINE") (cons 10 e3p1) (cons 11 e3p2)))
          (setq ent3 (entlast))
          (ssadd ent3 ss1)
          (ssdel ent1 ss1) (entdel ent1)
          (ssdel ent2 ss1) (entdel ent2)
          (setq Flag1 1)
        );progn
      );if
    );progn
  );if
 );if
);if
);defun

[GDF]

Check thses routines:

;;;SNAPLINE.LSP   Rectify Lines   (c)1998, Galen A. Light

and

AutoCAD's OVERKILL.lsp

[ANA]

Thanks, Gary. Do you have a link to that SNAPLINE.LSP? All I can find by googling it is this routine that changes the SNAPANG variable.

I work in BricsCad (Intellicad), so I don't have the Overkill express tool.

[T.Willey]

Here is one error

Code: [Select]

(if (/= n2 sslength ss1)
Should be

Code: [Select]

(if (/= n2 (sslength ss1))
See if fixing that will work.

[T.Willey]

I don't really like the flow of logic, but this seems to work with minimal changes to what you had.  I threw in some if statements to make sure your test numbers ( that grab entities from the selection set ) was not less than the number of items in the selection set.

Code: [Select]

(defun c:CleanUp ()
    ;;; CleanUp converts all co-linear sets of adjacent lines into single line entities.
    ;;; -------------------------------------------------------------------------------------------------------------
    ;;; If any two lines have the same slope and an endpoint in common,
    ;;; they're replaced by a single line,
    ;;; whose endpoints are the non-matching endpoints of the first two.
    ;;; That's repeated until no more matches are found.
    ;;; -------------------------------------------------------------------------------------------------------------
    ;;; Flag1 means a match was found and 2 lines were replaced by a new one,
    ;;;    i.e., start processing the selection set all over again.
    ;;; The new set is processed unless it's the same length as the last set (i.e. no matches found)
    ;;; To process a set, pick an Ent1 against which to compare all other lines in the set,
    ;;;    cycling through the set with counter n1 so every line gets a chance to be Ent1.
    ;;; To process an Ent1, pick an Ent2 against which to compare its slope and endpoints,
    ;;;    cycling through the set with counter n2 so every line gets compared to Ent1.
    ;;; To process an Ent2, first compare its slope against M, the slope of Ent1
    ;;;    If there's a match, see if either of its endpoints is the same as either endpoint of Ent1
    ;;;    If any match, create Ent3 using the non-matching endpoints of Ent1 & Ent2,
    ;;;    Delete Ent1 & Ent2, create Ent3 and add it to the selection set, and set Flag1.
    ;;; -------------------------------------------------------------------------------------------------------------
    (sssetfirst nil nil)
    (setq ss1 (ssget (list (cons 0 "LINE"))))
    (setq LenSS (sslength ss1))
    (setq LenSSLast 0)
    (setq Tol 0.00000000000001)  ;set tolerance for matching slopes
    (while (/= LenSS LenSSLast)
        (setq LenSSLast LenSS)
        (setq Flag1 0)
        (ProcSet)             ;call sub-routine
        (setq LenSS (sslength ss1))
    );while
    (sssetfirst nil ss1)
);defun
(defun ProcSet ()
    ;;; --------- sub-routine
    (setq n1 -1)
    (while (= Flag1 0)
        (ProcNextEnt1)       ;call sub-routine
    );while
);defun
(defun ProcNextEnt1 ()
    ;;; --------- sub-routine
    (setq n1 (+ n1 1))
    (if (< n1 (sslength ss1))
        (progn
            (setq Ent1 (ssname ss1 n1))
            (setq Ent1data (entget Ent1))
            (setq e1p1 (cdr (assoc 10 Ent1data)))
            (setq e1p2 (cdr (assoc 11 Ent1data)))
            (setq M (angle e1p1 e1p2))
            (setq n2 -1)
            (while (= Flag1 0)
                (ProcNextEnt2)       ;call sub-routine
            );while
        )
        (setq Flag1 1)
    )
);defun
(defun ProcNextEnt2 ()
    ;;; --------- sub-routine
    (setq n2 (+ n2 1))
    (if (< n2 (sslength ss1))
        (progn
            (setq Ent2 (ssname ss1 n2))
            (setq Ent2data (entget Ent2))
            (setq e2p1 (cdr (assoc 10 Ent2data)))
            (setq e2p2 (cdr (assoc 11 Ent2data)))
            (if (/= n1 n2)
                (if (OR (equal M (angle e2p1 e2p2) Tol)
                    (equal M (angle e2p2 e2p1) Tol))
                    (progn
                        (setq  e3p1 nil   e3p2 nil)
                        (if (equal e1p2 e2p1) (setq e3p1 e1p1   e3p2 e2p2))
                        (if (equal e1p2 e2p2) (setq e3p1 e1p1   e3p2 e2p1))
                        (if (equal e1p1 e2p2) (setq e3p1 e2p1   e3p2 e1p2))
                        (if (equal e1p1 e2p1) (setq e3p1 e2p2   e3p2 e1p2))
                        (if (equal e3p1 nil) (nil)
                            (progn
                                (entmake (list '(0 . "LINE") (cons 10 e3p1) (cons 11 e3p2)))
                                (setq ent3 (entlast))
                                (ssadd ent3 ss1)
                                (ssdel ent1 ss1) (entdel ent1)
                                (ssdel ent2 ss1) (entdel ent2)
                                (setq Flag1 1)
                            );progn
                        );if
                    );progn
                );if
            );if
        );progn
        (setq Flag1 1)
    );if
);defun


[ANA]

Thanks, Tim. Did you find that your version could join 5 lines into 1? In Bricscad, it still just handles up to 4. If I select 5 co-linear lines, it joins two pairs of them, leaving a total of 3 lines in place of the original 5. And if select a larger set, not all co-linear, it doesn't join any of them.

Maybe I should start over. What would be a better approach to organizing the flow for something like this?

[GDF]

Thanks, Gary. Do you have a link to that SNAPLINE.LSP? All I can find by googling it is this routine that changes the SNAPANG variable.

I work in BricsCad (Intellicad), so I don't have the Overkill express tool.

http://new.cadalyst.com/code/

May 1998 Rectify Lines routine.

[T.Willey]

Thanks, Tim. Did you find that your version could join 5 lines into 1? In Bricscad, it still just handles up to 4. If I select 5 co-linear lines, it joins two pairs of them, leaving a total of 3 lines in place of the original 5. And if select a larger set, not all co-linear, it doesn't join any of them.

I turned on ortho, drew six line segments at 0.0 degrees, ran the code, and all came together.  I don't know if it's a Briscad error, but the code seems to work on Acad '06.

Edit:  Maybe if you post a drawing I can test that, so that I can see the same conditions you are.

Maybe I should start over. What would be a better approach to organizing the flow for something like this?

I was trying to think of how I would do it, but wasn't sure how yet.  Let me see if I can come up with a better flow.

[ANA]

Tim, I hadn't tried ortho lines before; I was testing on slanted lines. I tried what you said (6 horizontal lines drawn with ortho on) and that worked in Bricscad. It also worked with vertical lines. And it worked when I drew one horizontal line and copied it 5 times.

But when I rotated the 6 lines to an arbitrary angle, or when I drew one slanted line and copied it 5 times, then it didn't work on the full 6, only on 4 of them.

After saving a file with 2 copies of the 6 horizontal lines, then it only worked on one of the copies. With the other copy, it would only work on 4 of them, even though they were horizontal!

It got much weirder after that, as I tried to find a pattern -- copying the sets of lines, saving new files and re-opening them, etc. I tried it for probably 2 hours, with results far too complex to describe. I even found it working on 6 slanted lines in many cases. I kept thinking I'd found the pattern, but then the next test disproved it. At one point I thought it was working on 4 or 6 lines but not on 5, but that pattern didn't hold up consistently. I tried lincreasing the tolerance, all the way up to 0.1, and I tried adding that tolerance to the tests for endpoint matching, but that didn't seem to change anything.

In the attached file, the 6 sets of 6 lines are all copies of the same set. The original set is at the lower left. Every time I open this file, the routine works on 5 of the sets, but not on the horizontal set at the lower right. When I try it on the jumble of lines at the far right, nothing happens. If I just select the 5 slanted lines at the bottom of the jumble, only 2 of the lines get consolidated, leaving 4 lines. Then selecting those 4 lines works. But with the 6 horizontals at the lower right, nothing gets converted when I select all 6. If I select 4 of them, that works, and then I can select it with the other 2 and that works.

Is this what you meant about dragging you down into the depth of hell?

--Anthony

[ANA]

Gary, that SnapLine command, in the file Tip1430.lsp in May98.zip, with this header:

;TIP1430.LSP:  SNAPLINE.LSP   Rectify Lines   (c)1998, Galen A. Light

does exactly what the description on the 1998 summary says:

Rectify Lines by Galen A. Light, p.101
an AutoLISP routine that snaps lines from their start points to the closest 45-degree increment.

A search for that author on Cadalyst's search engine gets 3 hits: "Rectify Lines," "Quick Snap Set," for setting SNAPANG & OSMODE, and "Edit Files," which has hundreds of lines of (write-char) & (write-line).

[T.Willey]

Tim, I hadn't tried ortho lines before; I was testing on slanted lines. I tried what you said (6 horizontal lines drawn with ortho on) and that worked in Bricscad. It also worked with vertical lines. And it worked when I drew one horizontal line and copied it 5 times.

But when I rotated the 6 lines to an arbitrary angle, or when I drew one slanted line and copied it 5 times, then it didn't work on the full 6, only on 4 of them.

After saving a file with 2 copies of the 6 horizontal lines, then it only worked on one of the copies. With the other copy, it would only work on 4 of them, even though they were horizontal!

It got much weirder after that, as I tried to find a pattern -- copying the sets of lines, saving new files and re-opening them, etc. I tried it for probably 2 hours, with results far too complex to describe. I even found it working on 6 slanted lines in many cases. I kept thinking I'd found the pattern, but then the next test disproved it. At one point I thought it was working on 4 or 6 lines but not on 5, but that pattern didn't hold up consistently. I tried lincreasing the tolerance, all the way up to 0.1, and I tried adding that tolerance to the tests for endpoint matching, but that didn't seem to change anything.

In the attached file, the 6 sets of 6 lines are all copies of the same set. The original set is at the lower left. Every time I open this file, the routine works on 5 of the sets, but not on the horizontal set at the lower right. When I try it on the jumble of lines at the far right, nothing happens. If I just select the 5 slanted lines at the bottom of the jumble, only 2 of the lines get consolidated, leaving 4 lines. Then selecting those 4 lines works. But with the 6 horizontals at the lower right, nothing gets converted when I select all 6. If I select 4 of them, that works, and then I can select it with the other 2 and that works.

Is this what you meant about dragging you down into the depth of hell?

--Anthony

Anthony,

  If I get some time today to look at this more in depth I will.  This has peaked my interest.

[ANA]

I found part of the problem, by putting in error messages to pinpoint where the routine was failing. It's this:

Code: [Select]

      (if (equal e3p1 nil) (nil)I always thought that was the way to do it, but apparently it's not. It worked during the preliminary stages of writing this routine, but I guess I just got lucky then. Replacing it with this:

Code: [Select]

      (if (equal e3p1 nil) nilgets rid of the anomalies that I described before. I can now select any of the 6 sets of 6 lines in the file I attached, or even all 6 sets at once, and get the desired result.

Bricscad kept telling me that was the problem: "error - no function definition <NIL> at [EVAL]" but I couldn't figure out what that meant. Doh!

Or, as Emily Litella would have said, "Never mind."

I'm still having the problem that selecting the "jumble" of lines in that file results in nothing being consolidated. But now that I know it's not some sort of demonic spirit intervening because of all those 6's, I'll keep working on it. There's probably another Lisp 101 error that I can't see because I never took that course. 

[T.Willey]

This one seems to work, if you run it twice.  Not sure why you have to run it twice yet.  It might be a little confusing though, as its the only way that came to mind while coding.

Edit:  Figured out why it needs to be ran twice, and have fixed it, and it works on your test drawing.

Code: [Select]

(defun c:CleanUp-TMW (/ ss ssLen EntList Ent EntData StPt EndPt Ang cnt tempStPt tempEndPt tempAng bShouldErase Tol Newss)
   
    (setq Tol 0.0000000001)
    (setq Newss (ssadd))
    (if (setq ss (ssget '((0 . "LINE"))))
        (while (> (setq  ssLen (1- (sslength ss))) 0)
            (setq EntList nil)
            (setq Ent (ssname ss 0))
            (setq EntData (entget Ent))
            (setq StPt (cdr (assoc 10 EntData)))
            (setq EndPt (cdr (assoc 11 EntData)))
            (setq Ang (angle StPt EndPt))
            (setq EntList (cons Ent EntList))
            (ssdel Ent ss)
            (setq cnt 0)
            (while (setq Ent (ssname ss cnt))
                (setq EntData (entget Ent))
                (setq tempStPt (cdr (assoc 10 EntData)))
                (setq tempEndPt (cdr (assoc 11 EntData)))
                (setq tempAng (angle tempStPt tempEndPt))
                (setq bShouldErase nil)
                (cond
                    (
                        (and
                            (equal StPt tempStPt Tol)
                            (equal Ang tempAng Tol)
                        )
                        (if (< (distance StPt EndPt) (distance StPt tempEndPt))
                            (progn
                                (setq EndPt tempEndPt)
                                (setq bShouldErase T)
                            )
                        )
                    )
                    (
                        (and
                            (equal StPt tempStPt Tol)
                            (equal (rem (+ Ang pi) (* 2. pi)) tempAng Tol)
                        )
                        (if (< (distance StPt EndPt) (distance EndPt tempEndPt))
                            (progn
                                (setq StPt tempEndPt)
                                (setq bShouldErase T)
                            )
                        )
                    )
                    (
                        (and
                            (equal StPt tempEndPt Tol)
                            (equal Ang tempAng Tol)
                        )
                        (if (< (distance StPt EndPt) (distance tempStPt EndPt))
                            (progn
                                (setq StPt tempStPt)
                                (setq bShouldErase T)
                            )
                        )
                    )
                    (
                        (and
                            (equal StPt tempEndPt Tol)
                            (equal (rem (+ Ang pi) (* 2. pi)) tempAng Tol)
                        )
                        (if (< (distance StPt EndPt) (distance StPt tempStPt))
                            (progn
                                (setq EndPt tempStPt)
                                (setq bShouldErase T)
                            )
                        )
                    )
                    (
                        (and
                            (equal EndPt tempEndPt Tol)
                            (equal Ang tempAng Tol)
                        )
                        (if (< (distance StPt EndPt) (distance StPt tempEndPt))
                            (progn
                                (setq StPt tempStPt)
                                (setq bShouldErase T)
                            )
                        )
                    )
                    (
                        (and
                            (equal EndPt tempEndPt Tol)
                            (equal (rem (+ Ang pi) (* 2. pi)) tempAng Tol)
                        )
                        (if (< (distance StPt EndPt) (distance StPt tempStPt))
                            (progn
                                (setq EndPt tempStPt)
                                (setq bShouldErase T)
                            )
                        )
                    )
                    (
                        (and
                            (equal EndPt tempStPt Tol)
                            (equal Ang tempAng Tol)
                        )
                        (if (< (distance StPt EndPt) (distance StPt tempEndPt))
                            (progn
                                (setq EndPt tempEndPt)
                                (setq bShouldErase T)
                            )
                        )
                    )
                    (
                        (and
                            (equal EndPt tempStPt Tol)
                            (equal (rem (+ Ang pi) (* 2. pi)) tempAng Tol)
                        )
                        (if (< (distance StPt EndPt) (distance tempStPt tempEndPt))
                            (progn
                                (setq StPt tempEndPt)
                                (setq bShouldErase T)
                            )
                        )
                    )
                    (t (setq cnt (1+ cnt)))
                )
                (if bShouldErase
                    (progn
                        (setq EntList (cons Ent EntList))
                        (ssdel Ent ss)
                        [color=red](setq cnt 0)[/color]
                    )
                )
            )
            (if EntList
                (progn
                    (foreach ent EntList
                        (entdel ent)
                    )
                    (entmake
                        (list
                            (cons 0 "LINE")
                            (cons 10 StPt)
                            (cons 11 EndPt)
                        )
                    )
                    (ssadd
                        (cdr
                            (assoc
                                -1
                                (entget (entlast))
                            )
                        )
                        Newss
                    )
                )
            )
        )
    )
    (if (> (sslength Newss) 0)
        (sssetfirst nil Newss)
    )
    (princ)
)


[CAB]

What about lines that are collinear and overlap. Are you going to consolidate them as well?

[T.Willey]

What about lines that are collinear and overlap. Are you going to consolidate them as well?

In mine, if they overlap, then they get erased.