Author Topic: Coding -={ Challenge }=- : Draw Pline at center of circles  (Read 4571 times)

0 Members and 1 Guest are viewing this topic.

BazzaCAD

  • Guest
Coding -={ Challenge }=- : Draw Pline at center of circles
« on: December 17, 2014, 05:46:29 PM »
OK here's my issue. I have a bunch of circles that together form a closed shape. I need to draw a Pline with the nodes at the center of each circle. I know I can code this if I pick each circle in the right order, but I have a ton of these to do, so I'd like to use a window select and some how have it sort the circles\points in the right order to draw the Pline. Does anyone have anything like this already coded? Or any suggestions. I would think civil engineers would have to do similar types of thinks to form contour lines...
Here's a before & after shot of what I'm trying to do.
« Last Edit: December 17, 2014, 06:08:53 PM by Kerry »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #1 on: December 17, 2014, 06:03:26 PM »
Ohhh interesting problem Barry.

I don't recall seeing a similar algorithm.

A bit of special logic would be required in locations where several circles touch .. as per the right side of your piccy.

I assume the circles are touching their neighbour ?

.. perhaps that could be resolved keeping a record of the vector of the last segment ..

May need a manual edit fixxer to add a vertex to the pline and move it to a circle center .. but that has been done before.

Wish I had some time to play.
« Last Edit: December 17, 2014, 06:09:29 PM by Kerry »
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.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #2 on: December 17, 2014, 06:19:54 PM »

On option may be to run a grread loop while you pass the mouse over the circles ;
then join the circles traversed. May be fairly speedy.

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.

BazzaCAD

  • Guest
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #3 on: December 17, 2014, 06:21:32 PM »
Actually they don't touch, just very close.
If I could get it 90% there, I could handle doing the manual clean up for the congested areas

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #4 on: December 17, 2014, 08:59:37 PM »
There is some code here to sort a point list by distance. With your example it should work well .. you might get some wonkiness on the ends though.

1. Select circles and get center points.
2. Sort points with function.
3. Draw pline.

Or use the gread option Kerry mentioned :) .
If no one has written something by tomorrow, I'll give it a go :) .

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #5 on: December 17, 2014, 11:04:53 PM »
This should be the difficult bit :

    If the mousepointer is passing over a circle,
         determine the center of the circle.
         and If the centerPoint is not in the PointList
         then :
           If the centerpoint is not the same as the first circle
              ie the loop is complete
           then:
               add the centerPoint to the PointList
               conditionally make the centerpoint the firstCircleCen
           else :
               Set the looping variable to nil


This could be embellished with highlighting etc, etc   
           
Code - Auto/Visual Lisp: [Select]
  1. (defun c:doit (/)
  2.    (defun mouse-moved (mousepoint)
  3.       (if (setq cenPt (osnap mousepoint "_cen"))
  4.          (cond
  5.             ((= 1 (length ptlist))
  6.              ;; we haven't left the first circle
  7.              (if (not
  8.                     (equal cenPt firstCircleCen 1e-8)
  9.                  )
  10.                 (setq ptlist (cons cenPt ptlist))
  11.              )
  12.             )
  13.             ((not (vl-position cenPt ptlist))
  14.              (setq ptlist (cons cenPt ptlist))
  15.             )
  16.             ;;
  17.             ((equal cenPt firstCircleCen 1e-8)
  18.  
  19.              (setq looping nil)
  20.  
  21.              (alert (strcat "The squircle is complete\n"
  22.                             (itoa (length ptlist))
  23.                             " Circles crossed"
  24.                     )
  25.              )
  26.             )
  27.          )
  28.       )
  29.    )
  30.    (defun space-bar () (setq looping nil) (princ))
  31.    ;;
  32.    ;; Main entry
  33.    ;;
  34.    (setq looping t
  35.          ptlist '()
  36.          firstCircleCen nil
  37.    )
  38.  
  39.    (if
  40.       (setq cenPt (osnap (cadr (entsel "Select First Circle : ")) "_cen"))
  41.         (setq firstCircleCen cenPt
  42.               ptlist (cons cenPt ptlist)
  43.         )
  44.         (exit)
  45.    )
  46.    (princ (strcat "\nPass mouse over next circle and subsequent circles"
  47.                   "\nFinishing at first circle.\nPress Space bar for emergency exit"
  48.           )
  49.    )
  50.  
  51.    (while looping
  52.       (setq code (grread t 8)
  53.             key  (car code)
  54.             data (cadr code)
  55.       )
  56.       (cond ((and (= key 5) (listp data)) (mouse-moved data))
  57.             ((equal code '(2 32)) (space-bar))
  58.       )
  59.    )
  60.    (princ "\nThanks for the fish")
  61.    (princ)
  62. )
  63.  
  64.  


added:
Wonder if anyone will notice I missed passing over one circle ... there are actually 41 ..
SO highlighting MAY be necessary :-)
« Last Edit: December 17, 2014, 11:21:45 PM by Kerry »
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.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #6 on: December 17, 2014, 11:12:59 PM »

Code - Auto/Visual Lisp: [Select]
  1. (mapcar 'print ptlist)

(1718.72 2242.29 0.0)
(1706.72 2239.98 0.0)
(1692.84 2239.25 0.0)
(1678.82 2239.25 0.0)
(1666.38 2238.82 0.0)
(1654.39 2237.95 0.0)
(1641.09 2238.68 0.0)
(1628.65 2239.4 0.0)
(1617.09 2239.98 0.0)
(1605.52 2241.71 0.0)
(1592.95 2244.31 0.0)
(1581.67 2247.63 0.0)
(1568.66 2251.82 0.0)
(1556.23 2246.33 0.0)
(1543.65 2241.42 0.0)
(1541.48 2255.72 0.0)
(1549.14 2265.97 0.0)
(1542.64 2279.98 0.0)
(1531.36 2289.66 0.0)
(1533.1 2302.23 0.0)
(1544.08 2299.05 0.0)
(1554.78 2293.27 0.0)
(1562.94 2286.06 0.0)
(1566.64 2276.23 0.0)
(1570.25 2266.12 0.0)
(1580.66 2270.74 0.0)
(1590.49 2276.66 0.0)
(1602.05 2279.41 0.0)
(1612.9 2275.8 0.0)
(1625.04 2272.33 0.0)
(1637.91 2271.32 0.0)
(1650.48 2276.09 0.0)
(1661.32 2281.28 0.0)
(1671.88 2285.62 0.0)
(1685.18 2288.51 0.0)
(1696.89 2282.15 0.0)
(1703.54 2271.9 0.0)
(1709.32 2261.93 0.0)
(1718.43 2254.85 0.0)
(1729.41 2248.79 0.0)
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.

owenwengerd

  • Bull Frog
  • Posts: 451
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #7 on: December 17, 2014, 11:31:17 PM »
This looks like a simplistic case of the travelling salesman problem, which I'm pretty sure has been addressed before here in the swamp.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #8 on: December 18, 2014, 12:57:05 AM »
Here's my quick stab at it:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ _daisychain _addlwpolyline pt pts ss x)
  2.   (defun _daisychain (pt lst / tmp newlst dsort)
  3.     (defun dsort (pt lst / d1 d2)
  4.       (vl-sort lst (function (lambda (d1 d2) (< (distance pt d1) (distance pt d2)))))
  5.     )
  6.     (setq tmp (dsort pt lst))
  7.     (while (setq tmp (dsort (car tmp) tmp))
  8.       (setq newlst (cons (car tmp) newlst)
  9.             tmp    (vl-remove (car tmp) tmp)
  10.       )
  11.     )
  12.     (reverse newlst)
  13.   )
  14.   (defun _addlwpolyline (layer width ptlst 0or1)
  15.                      (list (list '(0 . "LWPOLYLINE")
  16.                                  (cons 100 "AcDbEntity")
  17.                                  (cons 8 layer)
  18.                                  (cons 100 "AcDbPolyline")
  19.                                  (cons 90 (length ptlst))
  20.                                  (cons 43 width)
  21.                                  (cons 38 (caddr (trans '(0 0 0) 1 (trans '(0. 0. 1.) 1 0))))
  22.                                  (cons 70 0or1)
  23.                            )
  24.                            (mapcar '(lambda (x) (list 10 (car x) (cadr x))) ptlst)
  25.                            (list (cons 210 (trans '(0. 0. 1.) 1 0)))
  26.                      )
  27.               )
  28.     )
  29.   )
  30.   (if (and (setq ss (ssget '((0 . "circle"))))
  31.            (setq pts (mapcar '(lambda (x) (cdr (assoc 10 (entget x))))
  32.                              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  33.                      )
  34.            )
  35.            (> (length pts) 2)
  36.       )
  37.     (_addlwpolyline "yourlayer" 0.0 (_daisychain (car pts) pts) 1)
  38.   )
  39.   (princ)
  40. )
« Last Edit: December 18, 2014, 10:30:50 AM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

David Bethel

  • Swamp Rat
  • Posts: 656
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #9 on: December 18, 2014, 07:51:14 AM »
A kludge :

Code - Auto/Visual Lisp: [Select]
  1. (setq data '((1718.72 2242.29 0.0)(1706.72 2239.98 0.0)(1692.84 2239.25 0.0)
  2. (1678.82 2239.25 0.0)(1666.38 2238.82 0.0)(1654.39 2237.95 0.0)
  3. (1641.09 2238.68 0.0)(1628.65 2239.4 0.0)(1617.09 2239.98 0.0)
  4. (1554.78 2293.27 0.0)(1562.94 2286.06 0.0)(1566.64 2276.23 0.0)
  5. (1570.25 2266.12 0.0)(1580.66 2270.74 0.0)(1590.49 2276.66 0.0)
  6. (1602.05 2279.41 0.0)(1612.9 2275.8 0.0)(1625.04 2272.33 0.0)
  7. (1637.91 2271.32 0.0)(1650.48 2276.09 0.0)(1661.32 2281.28 0.0)
  8.  
  9. (1605.52 2241.71 0.0)(1592.95 2244.31 0.0)(1581.67 2247.63 0.0)
  10. (1568.66 2251.82 0.0)(1556.23 2246.33 0.0)(1543.65 2241.42 0.0)
  11. (1541.48 2255.72 0.0)(1549.14 2265.97 0.0)(1542.64 2279.98 0.0)
  12. (1531.36 2289.66 0.0)(1533.1 2302.23 0.0)(1544.08 2299.05 0.0)
  13.  
  14.  
  15. (1671.88 2285.62 0.0)(1685.18 2288.51 0.0)(1696.89 2282.15 0.0)
  16. (1703.54 2271.9 0.0)(1709.32 2261.93 0.0)(1718.43 2254.85 0.0)
  17. (1729.41 2248.79 0.0)))
  18.  
  19. (defun remove (expr lst);;;TonyT or VNesterowski
  20.   (apply 'append (subst nil (list expr) (mapcar 'list lst))))
  21.  
  22. (defun c:cline (/ pl sp d sp n)
  23.   (setq pl (list (car data)))
  24.   (setq sp (car data))
  25.   (setq data (cdr data))
  26.   (while (> (length data) 1)
  27.          (princ (strcat "\n" (itoa (length data))))
  28.          (setq d 1e+14)
  29.          (foreach v data
  30.            (if (< (distance sp v) d)
  31.                (setq d (distance sp v)
  32.                      n v)))
  33.          (setq pl (cons n pl)
  34.                sp n
  35.              data (remove n data)))
  36.   (setq pl (cons (car data) pl)
  37.         pl (cons (last pl) pl))
  38.   (command "_.3DPOLY")
  39.   (foreach v pl
  40.     (command v))
  41.   (command "")
  42.   (prin1))
  43.  
  44.  

Assuming:
 No duplicate points
 That the circles are not overlapping

-David
R12 Dos - A2K

hmspe

  • Bull Frog
  • Posts: 362
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #10 on: December 18, 2014, 08:54:15 AM »
Assuming that the circles are always close together I'd try creating a working set of circles with the same centers as the existing but with radius 1.1X the existing radius.  The scale factor might need to be adjusted depending on circle spacing to assure that the new circles always overlap.  I would then shrinkwrap [bounding box, offset the BB outward, hatch, get hatch boundary, get rid of all but the hatch boundary] to get an outer boundary.  The resulting polyline could be iterated to create the lines between the circle centers in order.
"Science is the belief in the ignorance of experts." - Richard Feynman

Patrick_35

  • Guest
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #11 on: December 18, 2014, 09:58:06 AM »
Hi

For example, i work with distance
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test(/ dis doc ele lst sel tab)
  2.   (and (ssget (list (cons 0 "circle")))
  3.     (progn
  4.       (vlax-for ent (setq sel (vla-get-activeselectionset doc))
  5.         (setq lst (cons (vlax-get ent 'center) lst))
  6.       )
  7.       (vla-delete sel)
  8.       (setq ele (car lst)
  9.             tab (list ele)
  10.             lst (cdr lst)
  11.       )
  12.       (while lst
  13.         (setq dis (mapcar '(lambda(x)(distance ele x)) lst)
  14.               ele (nth (vl-position (apply 'min dis) dis) lst)
  15.               tab (cons ele tab)
  16.               lst (vl-remove ele lst)
  17.         )
  18.       )
  19.       (entmake (append  (list
  20.                           (cons   0 "LWPOLYLINE")
  21.                           (cons 100 "AcDbEntity")
  22.                           (cons 100 "AcDbPolyline")
  23.                           (cons  90 (length tab))
  24.                           (cons  70 1)
  25.                         )
  26.                         (mapcar '(lambda(x) (cons 10 x)) tab)
  27.                )
  28.       )
  29.     )
  30.   )
  31.   (princ)
  32. )

@+

BazzaCAD

  • Guest
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #12 on: December 22, 2014, 04:12:31 PM »
WOW, what happened to my email notifications....
I thought my post went dead, but  now I see there's all this activity I missed.
Sorry guys.
Thanks for all the great contributions.
So far I think ronjonp & Patrick_35 are working the best, but I do like Kerry's very creative approach.
If the first 2 fail & can use it to get the order right.

Thanks again everyone.

BazzaCAD

  • Guest
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #13 on: December 22, 2014, 06:28:10 PM »
@ronjonp,
The elevation of the Pline doesn't seam to be getting set.
Is this line correct?

Code - Auto/Visual Lisp: [Select]
  1.  (cons 38 (caddr (trans '(0 0 0) 1 (trans '(0. 0. 1.) 1 0))))
  2.  

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Coding -={ Challenge }=- : Draw Pline at center of circles
« Reply #14 on: December 22, 2014, 08:22:28 PM »
Barry,
I built a routine essentially the same as ronjonps
except I used this, which honors the Z of the first point in the list.
kbub:entmakeplineinucs
http://www.theswamp.org/index.php?topic=34452.msg397246#msg397246
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.