Distance between a set of points

[surfer96]

Is there some routine to calculate the distance between all intersection points from a set of lines?

 

[ВeekeeCZ]

Look at Lee's page HERE

[Kent1Cooper]

I don't know off-hand, but first....  What do you mean by "the distance" in this situation?  "All intersectons" is a very large quantity.  Are you looking for a total  of all possible distances between all possible intersections?  [That would be huge!]  A list  of all those distances?  [An enormously long list!]  Only distances between intersections lying along the Lines, or also distances across open space to other intersections?  And do you want to include intersections of all the Lines with the perimeter, or only among the internal Lines?  Can you diagram what distances you want, and show the kind of result you're after?

What is the purpose?  There may be a different way to achieve the result you want.

[surfer96]

Yes, I'm looking for the total of distances between the total of intersection points.

The way to the code could be like:

• create all random lines in AuroLISP
• find the total of intersection points from the total of lines
• calculate the distance from "point1",  "point2" etc. to all other points
• combine "point1"-, "point2"- etc. distances to lists like: (dist p1-p2, dist p1-p3, etc.), (dist p2-p3, dist p2-p4, etc.)
• combine all p1-, p2-, etc. distance lists to one total distance list containing the total of distances
• sort the total distance list
• define the smallest, second smallest, largest and second largest members of the list as variables
• define a lower and upper boundary for a range (e.g. 2 to 50) of distances accepted
• the smallest and second smallest distance must not be smaller than the lower boundary (e.g. 2)
• the largest and second largest distance must not be larger than the upper boundary (e.g. 50)
• the boundary condition highly probably not being with the first set of lines...
• define a while loop with the lower and upper boundary as restrictions and restart from scratch

It will take millions of rounds through the loop which doesn't matter, provided the condition is finally fulfilled.

The point-based distance calculation is a tool to control the minimum and maximum of the areas of the resulting polygons in the pattern. The two min- and max-values for the distance indirectly define min- and max-equilateral-triangles and therefore min- and max-areas.

The sample drawing is a 100-100 mm box with 9 horizontal and 9 vertical inner random lines from edge to edge.

If the lines were regularly distributed in the box, all distances between all points would be 10 mm.

In the end, what I'm looking for is some kind of controlled chaos: basically accept a random distribution, but slightly control it by defining 2mm and 50mm as "chaos-boundaries".

I know this is a lot of input, but maybe the solution can be elaborated step by step. And the first necessity will be to get a total distance-list. I've joined an attachment sample with the box and the random lines. The so called maximum length for all lines can be removed from the sample. At the moment it is set to 140, so it does not have any impact.Random Lines / Regular Lines / Max Area

[marko_ribar]

If you are actually looking for maximum and minimum areas of regions between lines, I would suggest that you break all lines at intersections and then use REGION command to create regions from all of them... Of course the biggest region will be outline surrounding area, but you just remove that one and then analyze remaining... You can easily get - select and see what parts are minimum and what maximum, or second minimum and second maximum... For breaking lines, I suggest "BreakObjects.lsp" by Charles Alan Butler and use option, break all with no gaps if its possible, or simply iterate through all lines and find all intersection points between each pair of them and finally, apply BREAK command on list of those intersection points, supplying all entities that are met and pass through each intersection - perhaps with (ssget "_C" intpt intpt)... When you acquire those entities then (command "_.BREAK" "_F" "_non" intpt "_non" intpt) perhaps, or (command "_.BREAK" (list intpt (ssname (setq ss (ssget "_C" intpt intpt)) 0)) (list intpt (ssname ss 1)))... For regions and their areas, just iterate through list of them (of course without biggest outline one), and use (vla-get-area (vlax-ename->vla-object region-ename))... Or (setq arealst (mapcar '(lambda ( x ) (vla-get-area x)) (mapcar 'vlax-ename->vla-object region-list)))... Then simple sort of this list of areas with (vl-sort arealst '<)...

[marko_ribar]

Just checked BREAK command... Actually for 2 lines crossing each other - one "e1" and other "e2", syntax would be :

(command "_.BREAK" e1 "_non" intpt "_non" intpt "_.BREAK" e2 "_non" intpt "_non" intpt)

HTH., M.R.

[surfer96]

Although not very fast, this one, mainly based on  Charles Alan Butler's "BreakObjects.lsp", is working.

The lower boundary for the region area range is set to the very small value of 0.01, just to verify if the routine is working at all in acceptable time.

Does anyone have an idea, how it could be made considerably faster in AutoLISP?

And what about VB.NET, would that enhance speed?

[surfer96]

The distance approach might seem odd at first sight.

But I thought reducing the task to the mathematical basis of mere points, might enhance calculaion speed...

[surfer96]

I used Lee's functions and got all intersection points between all lines.

Is there any routine to calculate all distances between all intersection points as well?

[CodeDing · Accepted solution]

@surfer96,

This function will return the distances between all points (without duplicates).

Code w/ Example List:

(defun c:TEST ( / x)
(setq x '((0 0) (0 1) (0 3) (0 6) (0 10)))
(princ (GetDistances x))
(princ)
);defun

(defun GetDistances (pList / dList tmpList tmp tmp2 len)
(setq len (length pList))
(setq tmp 0)
(repeat (- len 1)
  (setq tmp2 (+ tmp 1) tmpList '())
  (repeat (- len tmp2)
    (setq d (distance (nth tmp pList) (nth tmp2 pList)))
    (setq tmpList (cons d tmpList))
    (setq tmp2 (1+ tmp2))
  );repeat
  (setq dList (cons (reverse tmpList) dList))
  (setq tmp (1+ tmp))
);repeat
(reverse dList)
);defun

...and this is the returned list. <i.e. in this fashion.. ((1->2  1->3  1->4  1->5) (2->3  2->4  2->5) (3->4  3->5) (4->5))>

Command: TEST
((1.0 3.0 6.0 10.0) (2.0 5.0 9.0) (3.0 7.0) (4.0))

Hope this helps.

Best,

~DD

[dani-perez]

Hello CodeDing

How does your code work? 

[surfer96]

Your code helped a lot to find all distances between all intersection points. I flattened the outcoming lists to one distance list using parts of LM:flatten.

The point distance appoach turned out to be slightly faster compared to breaking or sclicing objects and then evaluating their areas or volumes.

But looping is still not fast enough for my purposes. Maybe I'll give it a try with VB.NET...

[CodeDing]

@surfer96 , 

No need to use flatten. The code can output one single list with simple edits. Might make it a bit faster.

(defun GetDistances (pList / dList tmp tmp2 len)
(setq len (length pList))
(setq tmp 0)
(repeat (- len 1)
  (setq tmp2 (+ tmp 1) tmpList '())
  (repeat (- len tmp2)
    (setq d (distance (nth tmp pList) (nth tmp2 pList)))
    (setq dList (cons d dList))
    (setq tmp2 (1+ tmp2))
  );repeat
  (setq tmp (1+ tmp))
);repeat
dList
);defun

[surfer96]

@CodeDing,

It seems to be slightly faster without flattening.

Here's the lsp, do you have further ideas to speed up the code?

[CodeDing]

@surfer96 ,

You've done a pretty good job here. I didn't see a whole lot to change really. Made some changes to try to help.

- tried a new version of GetDistances

- add items to "sel" on the fly instead of after they're all created

- moved helper-functions to OUTSIDE of your command. You were building them every time in your while loop.

- LM:intersections already returns a list of points. no need to loop afterwards. 

See attached file and tell me if it's faster. I didn't compare to your original yet.

Best,

~DD

[marko_ribar]

Hi, its me again...

I know its not my business, but I still think that you should break lines at those intersections you get with (LM:intersections)... As far as I see you operate with point list, neglecting the fact that each point belong to some line... If lines are broken at intersections, you only have to sort them all by their lengts and that's all, finished story... If you need areas on the other hand, you have extra step I described in my previous posts - REGION command and so on... Or after all I am missing something you solved but I can't see, my opinion is that you are collecting all distances no matter points are on real line or there are no connections - empty spaces between points... Correct me but I know that you are looking for real not imaginary connections, right?

[surfer96]

Thanks a lot for your improved version which has slightly accelerated the loop. Of course its speed depends on random numbers, but  your method takes roughly 60 to 70 millisecs for one round through the loop, compared to 80 millisecs in the solution I had before.

Intersection points between random lines and the outer box must also be considered.

Therefore I think you forgot to include the 100-100-box-lines in the ssadd-function:

   (setq b1	  (vlax-3d-point 0 0 0)
	  b2	  (vlax-3d-point bw 0 0)
	  b3	  (vlax-3d-point bw bw 0)
	  b4	  (vlax-3d-point 0 bw 0)
	  lineObj (vla-AddLine modelSpace b1 b2)
	  sel (ssadd (vlax-vla-object->ename lineObj) sel); s96
	  lineObj (vla-AddLine modelSpace b2 b3)
	  sel (ssadd (vlax-vla-object->ename lineObj) sel); s96
	  lineObj (vla-AddLine modelSpace b3 b4)
	  sel (ssadd (vlax-vla-object->ename lineObj) sel); s96
	  lineObj (vla-AddLine modelSpace b4 b1)
	  sel (ssadd (vlax-vla-object->ename lineObj) sel); s96
    )

[surfer96]

I've tried the breakall-region-area option already, but it seemed to be slower, yet geometrically more precise, than the distance-all-points approach.

What I have not done so far, is to stop after breaking all lines with one another and then just evaluate their lengths.

You got a point there with your remark, I may try it some time in the future...

[marko_ribar]

Here is my version for breaking lines - open curves... After that you only have to select them again and sort by lengths... HTH.

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;; Intersections in Object List  -  Lee Mac
;; Returns a list of all points of intersection between all objects in a list of VLA-Objects.
;; lst - [lst] List of VLA-Objects

(defun LM:intersectionsinobjlist ( lst / ob1 rtn )
    (while (setq ob1 (car lst))
        (foreach ob2 (setq lst (cdr lst))
            (setq rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn))
        )
    )
    (apply 'append (reverse rtn))
)

(defun c:breakopencurvesatintersections-nogap ( / unique ss i e lst plst uplst elst )

    (vl-load-com)

    (defun unique ( l )
        (if l
            (cons (car l)
                (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))
            )
        )
    )

    (prompt "\nSelect intersecting open curve entities on unlocked layer(s)...")
    (setq ss (ssget "_:L"))
    (if ss
        (progn
            (repeat (setq i (sslength ss))
                (setq e (ssname ss (setq i (1- i))))
                (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list e)))) (null (vlax-curve-isclosed e)))
                    (setq lst (cons e lst))
                )
            )
            (setq plst (LM:intersectionsinobjlist (mapcar 'vlax-ename->vla-object lst)))
            (setq uplst (unique plst))
            (foreach p uplst
                (vl-cmdf "_.break" "_non" p "_non" p)
                (while (vl-some '(lambda ( x ) (and (not (equal p (vlax-curve-getstartpoint x) 1e-6)) (not (equal p (vlax-curve-getendpoint x) 1e-6)))) (setq elst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_C" p p))))))
                    (foreach e elst
                        (if (and (not (equal p (vlax-curve-getstartpoint e) 1e-6)) (not (equal p (vlax-curve-getendpoint e) 1e-6)))
                            (vl-cmdf "_.break" e "_non" p "_non" p)
                        )
                    )
                )
            )
        )
    )
    (princ)
)

M.R.

[marko_ribar]

Improvement of my code, but it don't work quite well with SPLINEs... Fortunately you have lines and boundary outline...

(defun c:breakopencurvesatintersections-nogap ( / unique LM:intersections LM:intersectionsinobjlist ucsf ss i e lst plst uplst elst )

    (vl-load-com)

    (defun unique ( l )
        (if l
            (cons (car l)
                (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))
            )
        )
    )

    ;; Intersections  -  Lee Mac
    ;; Returns a list of all points of intersection between two objects
    ;; for the given intersection mode.
    ;; ob1,ob2 - [vla] VLA-Objects
    ;;     mod - [int] acextendoption enum of intersectwith method

    (defun LM:intersections ( ob1 ob2 mod / lst rtn )
        (if (and (vlax-method-applicable-p ob1 'intersectwith)
                 (vlax-method-applicable-p ob2 'intersectwith)
                 (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
            )
            (repeat (/ (length lst) 3)
                (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                      lst (cdddr lst)
                )
            )
        )
        (reverse rtn)
    )

    ;; Intersections in Object List  -  Lee Mac
    ;; Returns a list of all points of intersection between all objects in a list of VLA-Objects.
    ;; lst - [lst] List of VLA-Objects

    (defun LM:intersectionsinobjlist ( lst / ob1 rtn )
        (while (setq ob1 (car lst))
            (foreach ob2 (setq lst (cdr lst))
                (setq rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn))
            )
        )
        (apply 'append (reverse rtn))
    )

    (if (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    )
    (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    (if (= (getvar 'worlducs) 0)
        (progn
            (vl-cmdf "_.ucs" "_w")
            (vl-cmdf "_.plan" "")
            (setq ucsf t)
        )
        (vl-cmdf "_.plan" "")
    )
    (while
        (or
            (prompt "\nSelect intersecting open curve entities on unlocked layer(s)...")
            (not (setq ss (ssget "_:L" (list '(-4 . "<or") '(0 . "LINE,XLINE,RAY,ARC,HELIX") '(-4 . "<and") '(0 . "*POLYLINE,SPLINE") '(-4 . "<not") '(-4 . "&=") '(70 . 1) '(-4 . "not>") '(-4 . "and>") '(-4 . "<and") '(0 . "ELLIPSE") '(-4 . "<not") '(-4 . "<and") '(41 . 0.0) (cons 42 (* 2 pi)) '(-4 . "and>") '(-4 . "not>") '(-4 . "and>") '(-4 . "or>")))))
        )
        (prompt "\nEmpty sel.set...")
    )
    (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (setq lst (cons e lst))
    )
    (setq plst (LM:intersectionsinobjlist (mapcar 'vlax-ename->vla-object lst)))
    (setq uplst (unique plst))
    (foreach p uplst
        (vl-cmdf "_.zoom" "_c" p 0.025)
        (vl-cmdf "_.regen")
        (vl-cmdf "_.break" "_non" p "_non" p)
        (while (vl-some '(lambda ( x ) (and (not (equal p (vlax-curve-getstartpoint x) 1e-6)) (not (equal p (vlax-curve-getendpoint x) 1e-6)))) (setq elst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_C" p p))))))
            (foreach e elst
                (if (and (not (equal p (vlax-curve-getstartpoint e) 1e-6)) (not (equal p (vlax-curve-getendpoint e) 1e-6)))
                    (vl-cmdf "_.break" e "_non" p "_non" p)
                )
            )
        )
        (vl-cmdf "_.zoom" "_p")
    )
    (if ucsf
        (vl-cmdf "_.ucs" "_p")
    )
    (vl-cmdf "_.zoom" "_p")
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    (princ)
)

HTH., M.R.