Author Topic: {Challenge} connect each two points whose distance is shorter than given value  (Read 100410 times)

0 Members and 1 Guest are viewing this topic.

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Attachment is a dwg contains 10000 random points.

Then the challenge is to connect each two points whose distance is shorter than given value, in this dwg the value is 70.

My first code (as follows) is very very slow for 10000 points, when for few points, it can solve. And I think I can improve it more quickly.

I hope you can give more effective way.

Code: [Select]
(vl-load-com)
;;stdlib
(defun std-sslist (ss / n lst)
  (if (eq 'pickset (type ss))
    (repeat (setq n (fix (sslength ss))) ; fixed
      (setq lst (cons (ssname ss (setq n (1- n))) lst))
    )
  )
)
;;make layer or turn on current layer
(defun mylayer (str)
  (if (tblsearch "LAYER" str)
    (command "._-Layer" "_set" str "")
    (command "._-Layer" "_Make" str "")
  )
)
;;
;;entmake line
(defun entmakeline (pt1 pt2 layer)
  (entmake (list (cons 0 "LINE") ;***
(cons 6 "BYLAYER") (cons 8 layer) (cons 10 pt1) ;***
(cons 11 pt2) ;***
(cons 39 0.0) (cons 62 256) (cons 210 (list 0.0 0.0 1.0))
  )
  )
);;
;;get the point coordinate
(defun mygetpoint (lst / plst)
  (foreach x lst
    (setq plst (append
plst
(list (cdr (assoc 10 (entget x))))
      )
    )
  )
  plst
)
;;Main
(defun c:gap ( / c i j len len1 limdis pj plst x)
  (mylayer "temp")
  (setq limdis 70)
  (setq c (ssget '((0 . "POINT"))))
  (setq c (std-sslist c))
  (setq plst (mygetpoint c))
  (setq i 0
len (length plst)
  )
  (foreach x plst
    (princ "\n               i = ") (princ i);Erase_DV
    (setq j (1+ i)
 len1 (- len j)
    )
    (repeat len1
      (setq pj (nth j plst))
      (if (< (distance x pj) limdis)
(entmakeline x pj "temp")
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
)


« Last Edit: April 02, 2010, 09:01:51 PM by yuanqiu »
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
zomg it's full of starz!!
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

ronjonp

  • Needs a day job
  • Posts: 7524
Well ... here's mine to start it off  :-)
Code: [Select]
(defun c:test (/ d e n out pt ss)
  (and
    (setq n -1)
    (setq d 70.)
    (setq ss (ssget '((0 . "point"))))
    (while (setq e (ssname ss (setq n (1+ n))))
      (setq out (cons (cdr (assoc 10 (entget e))) out))
    )
    (setq out (vl-sort out (function (lambda (x1 x2) (< (car x1) (car x2))))))
    (while (setq pt (car out))
      (mapcar (function
(lambda (x) (entmakex (list '(0 . "LINE") (cons 10 pt) (cons 11 x))))
      )
      (vl-remove-if
(function (lambda (x) (>= (distance pt x) d)))
(setq out (cdr out))
      )
      )
    )
  )
  (princ)
)
« Last Edit: April 02, 2010, 01:34:18 PM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 12904
  • London, England
Not sure how quick this'll be:

Code: [Select]
(defun PointGap (gap / GetPoints Pts tmp x y)

  (defun GetPoints (ss / e i l)
    (setq i -1)
    (if ss
      (while (setq e (ssname ss (setq i (1+ i))))
        (setq l (cons (cdr (assoc 10 (entget e))) l))))
    l)

  (if (setq Pts (GetPoints (ssget "_X" '((0 . "POINT")))))
    (while (setq x (car Pts))

      (setq tmp (cdr Pts))
      (while (setq y (car tmp))

        (if (< (distance x y) gap)
          (entmakex (list (cons 0 "LINE")
                          (cons 10 x) (cons 11 y))))
       
        (setq tmp (cdr tmp)))

      (setq Pts (cdr Pts))))

  (princ))

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
 :|


Code: [Select]
(_connect (_GetPnts) 70.))
(_connect2 (_GetPnts) 70.))


Code: [Select]
(defun _GetPnts (/ ss i)
  (setq i -1)
  (if (setq ss (ssget "_X" '((0 . "POINT"))))
    (while (setq e (ssname ss (setq i (1+ i))))
      (setq l (cons (cdr (assoc 10 (entget e))) l))
    ) ;_ while
  ) ;_ if
) ;_ defun


(defun _Line (a b) (entmakex (list '(0 . "LINE") (cons 10 b) (cons 11 a))))


(defun _connect (lst d / lst)
  (foreach x lst
    (foreach i (setq lst (vl-remove x lst))
      (and (< (distance x i) d)
           (_Line x i)
      ) ;_ and
    ) ;_ foreach
  ) ;_ foreach
) ;_ defun


(defun _connect2 (lst d / lst)
  (while (setq a (car lst))
    (foreach x (setq lst (cdr lst))
      (and (< (distance a x) d)
           (_Line a x)
      ) ;_ and
    ) ;_ foreach
  ) ;_ while
) ;_ defun
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

gile

  • Gator
  • Posts: 2505
  • Marseille, France
Hi,

Here's my way, quite similar to those posted before.

Code: [Select]
(defun foo (dist / n ss ent lst pt)
  (if (setq n  -1
    ss (ssget "_X" '((0 . "POINT")))
      )
    (while (setq ent (ssname ss (setq n (1+ n))))
      (setq lst (cons (cdr (assoc 10 (entget ent))) lst))
    )
  )
  (while lst
    (setq pt  (car lst)
  lst (cdr lst)
    )
    (foreach p lst
      (if (<= (distance pt p) dist)
(entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 p)))
      )
    )
  )
)
Speaking English as a French Frog

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Hi,

Here's my way, quite similar to those posted before.
Code: [Select]
<=

Would have been smart of me to do the same.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

pkohut

  • Guest
Ug, to busy to play, but can't resist   ^-^. Will post ARX code in a bit.

gile

  • Gator
  • Posts: 2505
  • Marseille, France
Hi,

A C# solution
Much more faster than LISP. With the sample drawing and a 70.0 length:
LISP = about 45 seconds
C# = about 2 seconds
Maybe ARX shoulde be faster...

Code: [Select]
using System;
using Autodesk.AutoCAD.ApplicationServices;
using Autodesk.AutoCAD.DatabaseServices;
using Autodesk.AutoCAD.EditorInput;
using Autodesk.AutoCAD.Geometry;
using Autodesk.AutoCAD.Runtime;

namespace ChallengeConnectPoints
{
    public class Connect
    {

        [CommandMethod("Test")]
        public void Test()
        {
            Editor ed = Application.DocumentManager.MdiActiveDocument.Editor;
            PromptDistanceOptions pdo = new PromptDistanceOptions("\nConnection distance: ");
            pdo.AllowNegative = false;
            pdo.AllowZero = false;
            PromptDoubleResult pdr = ed.GetDistance(pdo);
            if (pdr.Status == PromptStatus.OK)
                ConnectPoints(pdr.Value);
        }

        private void ConnectPoints(double d)
        {
            Document doc = Application.DocumentManager.MdiActiveDocument;
            Database db = doc.Database;
            Editor ed = doc.Editor;
            TypedValue[] tv = new TypedValue[1] { new TypedValue(0, "POINT") };
            PromptSelectionResult psr = ed.SelectAll(new SelectionFilter(tv));
            if (psr.Status != PromptStatus.OK)
                return;
            using (Transaction tr = db.TransactionManager.StartTransaction())
            {
                Point3d[] pts = Array.ConvertAll<ObjectId, Point3d>(
                    psr.Value.GetObjectIds(), x => ((DBPoint)x.GetObject(OpenMode.ForRead)).Position);
                int cnt = pts.Length;
                BlockTableRecord btr =
                    (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite);
                for (int i = 0; i < cnt; i++)
                {
                    for (int j = i + 1; j < cnt; j++)
                    {
                        if (pts[i].DistanceTo(pts[j]) <= d)
                        {
                            Line l = new Line(pts[i], pts[j]);
                            btr.AppendEntity(l);
                            tr.AddNewlyCreatedDBObject(l, true);
                        }
                    }
                }
                tr.Commit();
            }
        }
    }
}

You can try tne DLL in the ZIP file.
« Last Edit: April 02, 2010, 06:19:29 PM by gile »
Speaking English as a French Frog

pkohut

  • Guest
Hi,

A C# solution
Much more faster than LISP. With the sample drawing and a 70.0 length:
LISP = about 45 seconds
C# = about 2 seconds
Maybe ARX shoulde be faster...

Nice Gile.

I'm taking a none brute force approach, initial results look promising  ;-) Have an hour or so of coding left to do.

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Have an hour or so of coding left to do.
Man, one really pays for performance. I'm not knocking C/Arx, just taken aback at the amount of time.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

pkohut

  • Guest
Have an hour or so of coding left to do.
Man, one really pays for performance. I'm not knocking C/Arx, just taken aback at the amount of time.

Your right, and this is even repurposing code I've already written. The solution though is non-trivial, but screams. Tested with a million points and it's under a second. Still coding though so back to work  :lmao:

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Have an hour or so of coding left to do.
Man, one really pays for performance. I'm not knocking C/Arx, just taken aback at the amount of time.

Your right, and this is even repurposing code I've already written. The solution though is non-trivial, but screams. Tested with a million points and it's under a second. Still coding though so back to work  :lmao:
:lol:

Can't wait to see it!!
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Have an hour or so of coding left to do.
Man, one really pays for performance. I'm not knocking C/Arx, just taken aback at the amount of time.

Your right, and this is even repurposing code I've already written. The solution though is non-trivial, but screams. Tested with a million points and it's under a second. Still coding though so back to work  :lmao:
:lol:

Can't wait to see it!!

Yes you can, really, you can.  :-)
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Thank you all :), Your algorithms are all faster than me.
In my PC, (E7500 CPU, 4G Mem)
Ronjonp 's code, about 34.812967s
Lee Mac's code, about 40.733018s
Gile's code 42.111982s
alanjt's code is about 50s
Mine first code is very slow.   :-D, (could you tell me which cause the very slow)
Not very accurate test.

And I hope to see pkohut's super code :)

I am thinking about the "Divide and conquer algorithm", but I need some time to sort the point in some manner, and not so sure about whether it can be improved, because the sort also need some times.


http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)