Largest area from shotgun pattern?

[Anonymous]

I'd like to create a routine that traces a polyline around a cluster of
points. It must go point to point to point, etc. When finished, there must
be no points outside the polyline.

I suspect that someone has already done this. Any suggestions?

Len Miller

[Anonymous]

Clarify a thing or two for me....

Would the Polyline
A) have vertices at *all* the points, or
B) surround the points, with perhaps some of them *inside* but not *on* it?

Are there any criteria for the shape of the Polyline? For instance, must it be *convex* all around
[sort-of implied by your Subject line, but not necessarily required by it], or can there be
*inward*-pointing vertices [which would often be necessary if the first question's answer is A]?

--
Kent Cooper


"Fatfreek" wrote...
I'd like to create a routine that traces a polyline around a cluster of
points. It must go point to point to point, etc. When finished, there must
be no points outside the polyline.
....

[Anonymous]

Hi Kent,

Yes, the polyline must have vertices at all the points.
Yes, the polyline would surround all points not included in its vertices.

Imagine shooting a shotgun to a paper target, then taking a straightedge to
the outermost holes (okay, points) and drawing straight lines between each
of those, making sure when finished that you have one contiguous series of
lines and that no point is outside that boundary. If needed, take that
collection of lines and join them into a single polyline.

Here's my motive. I have a cluster of closed polylines, most of them
touching or intersecting each other. My first trial was to turn them into
Regions, then use the Union command on that group of regions.

That works -- most of the time.

My next trial was to move this cluster away from its current location, then
move them back into their original location, one by one. As I move the
second one, make a region of those two, throw away the polyline originals,
move the third in place, make a region of that and Union it to the first
Unioned pair, etc. Too complex to describe, so here's my code.

(setq CutterMaze
(grabzem); a function that ssgets the polys
CutrDex 0
ThisCutr nil
TwoRegions
nil
AllUnions nil
)
(command "_.move" CutterMaze "" "0,0" "-0.7,0")
(repeat (sslength CutterMaze)
(setq ThisCutr (ssname CutterMaze CutrDex))
(command "_.move" ThisCutr "" "-0.7,0" "0,0")
(command "._region" ThisCutr AllUnions "")
(command "._erase" ThisCutr "")
(setq TwoRegions (ssget "_x" '((8 . "cut_lines") (0 . "region"))))
(command "._union" TwoRegions "")
(setq AllUnions (ssadd (entlast)))
(setq CutrDex (1+ CutrDex))
)

As I single step my way the routine works beautifully till about halfway,
when a Region is made that looks like two regions welded together.
Exploding that region and you have two unique Regions each with its own
perimeter, although two vertices are shared (like Siamese twin babies). If
push came to shove I could then produce two closed polys, get a list of both
sets of vertices, eliminate the duplicate vertices, then build a single
closed poly.


Len

"Kent Cooper" wrote in message
news:6095366@discussion.autodesk.com...
Clarify a thing or two for me....

Would the Polyline
A) have vertices at *all* the points, or
B) surround the points, with perhaps some of them *inside* but not *on*
it?

Are there any criteria for the shape of the Polyline? For instance, must it
be *convex* all around
[sort-of implied by your Subject line, but not necessarily required by it],
or can there be
*inward*-pointing vertices [which would often be necessary if the first
question's answer is A]?

--
Kent Cooper


"Fatfreek" wrote...
I'd like to create a routine that traces a polyline around a cluster of
points. It must go point to point to point, etc. When finished, there must
be no points outside the polyline.
....

[Anonymous]

Fatfreek wrote:

> I suspect that someone has already done this.

Shrinkwrap Points. Triangulate the points, follow the outer edges.
Outer edges are those that triangles only pass over once.

Terry
--
Never start any job without the right tools!
AutoCAD Add-on Tools at http://www.dotsoft.com

[Anonymous]

Fatfreek wrote:

> I'd like to create a routine that traces a polyline around a cluster
> of points. It must go point to point to point, etc. When finished,
> there must be no points outside the polyline.

If you wanted to use AutoCAD functionality, you should be able to draw
lines from every point to every other point, generate a large rectangle
outside the bounding box of the points and use BPOLY, keeping the inner
polyline.

Terry
--
Never start any job without the right tools!
AutoCAD Add-on Tools at http://www.dotsoft.com

[Anonymous]

If you wanted to use AutoCAD functionality, you should be able to draw
lines from every point to every other point, generate a large rectangle
outside the bounding box of the points and use BPOLY, keeping the inner
polyline.

Hi Terry,

I want to use (within R2005) whatever will do the job. My first try with
your suggestion works (see attached) with a simplified set of polys.

I'll see if I can automate this and put it through some extreme cases.

Thanks very much for giving me something I can work with.

Len

[Anonymous]

Given that description, there could be multiple interpretations. See
attached.

"Fatfreek" wrote in message
news:6095320@discussion.autodesk.com...
I'd like to create a routine that traces a polyline around a cluster of
points. It must go point to point to point, etc. When finished, there must
be no points outside the polyline.

I suspect that someone has already done this. Any suggestions?

Len Miller

[Anonymous]

Hmmm ... I see what you're saying, Doug. Thanks for sharing that example.

Len

"Doug Broad" wrote in message
news:6095436@discussion.autodesk.com...
Given that description, there could be multiple interpretations. See
attached.

"Fatfreek" wrote in message
news:6095320@discussion.autodesk.com...
I'd like to create a routine that traces a polyline around a cluster of
points. It must go point to point to point, etc. When finished, there must
be no points outside the polyline.

I suspect that someone has already done this. Any suggestions?

Len Miller

[Anonymous]

Hi Fatfreek,

You're right. It's been done lots of times.

Search the web for "Convex Hull". It's a while since I did it, but I'm
sure you find AutoCAD solutions as well as all theory and explanations
you need.

Regards


Laurie Comerford

Fatfreek wrote:
> I'd like to create a routine that traces a polyline around a cluster of
> points. It must go point to point to point, etc. When finished, there must
> be no points outside the polyline.
>
> I suspect that someone has already done this. Any suggestions?
>
> Len Miller

[Anonymous]

Hi Laurie,

I got some 37 hits on your suggestion. What I read tends to intimidate me.
If push comes to shove, I may return to those threads.

Thanks for that lead.

For now it seems that the Bpoly suggestion is working for me on even the
complex mazes of closed polys that I've thrown at it. More testing though
after Santa comes. I hope it works since it's so simple.

Len

"Laurie Comerford" wrote in message
news:6095460@discussion.autodesk.com...
Hi Fatfreek,

You're right. It's been done lots of times.

Search the web for "Convex Hull". It's a while since I did it, but I'm
sure you find AutoCAD solutions as well as all theory and explanations
you need.

Regards


Laurie Comerford

Fatfreek wrote:
> I'd like to create a routine that traces a polyline around a cluster of
> points. It must go point to point to point, etc. When finished, there
must
> be no points outside the polyline.
>
> I suspect that someone has already done this. Any suggestions?
>
> Len Miller

[Anonymous]

Here's a 2D convex hull routine I spent an enjoyable afternoon on.
Draws an LWpolyline parallel to the WCS -- haven't yet worked out just
where to use (trans) to generate the hull parallel to other UCS's.



-Bill



;|

ConvexHull2D.lsp

draws, parallel to the WCS, the 2D Least Convex Hull

of a set of POINTs, by the wrapping method



by Bill Gilliss

bill dot gilliss at aya.yale.edu

ver 1.0 Dec 24 2008 - initial release



Comments and suggestions always welcome.

|;



(defun c:ConvexHull2D

  ( / getPointList getBasePoint findSmallestAngle ptlist hullList pts

       p1 p3 )





;;=====================================================

(defun getPointList ( / n )

  (setq ptlist nil hullList nil)

  (prompt "Select points: ")

  (setq pts (ssget '((0 . "POINT"))))

  (setq n 0)

  (while (< n (sslength pts))

    (setq ptlist (cons (cdr (assoc 10 (entget (ssname pts n)))) ptlist))

    (setq n (1+ n))

    )

)



;;=====================================================

(defun getBasePoint ( / n en ed enx eny xmax ymax)

  (setq n 0)

  (while

    (< n (sslength pts))

    (setq en (ssname pts n)

          ed (entget en)

          enx (cadr  (assoc 10 ed))

          eny (caddr (assoc 11 ed))

          )

    (if (= n 0)

        (setq basepoint en  xmax enx  ymax eny)

        (if

          (> enx xmax)

          (setq basepoint en  xmax enx  ymax eny)

          (if

             (and (equal enx xmax)

                  (> eny ymax)

                  )

             (setq basepoint en  xmax enx  ymax eny)

             );if

           );if

        );if



     (setq n (1+ n))

   );while

  (setq basepoint (cdr (assoc 10 (entget BasePoint))))

  (setq p1 basepoint)

  (setq p3 nil)

)





(defun findSmallestAngle ( / n p2 smallestAng) 

  (setq smallestAng (* 2 pi))

  (setq n 0)

  (while

    (< n (length ptlist))

    (setq p2 (nth n ptlist))

    (if (and

          (not (equal p1 p2))

          (not (member p2 hullList))

          )

      (progn

        (setq ang (angle (trans p1 0 1) (trans p2 0 1)))

        (if (and

              (< ang smallestAng)

              (not (equal ang 0.0 1e-12))

              )

            (setq smallestAng ang   p3 p2)

            )

        )

      )

    (setq n (1+ n))

    );while

  )



;;============================================ 

(defun makePolyline () 

  (setq polylist

    (list

      '(0 . "LWPOLYLINE")

      '(100 . "AcDbEntity")

      '(100 . "AcDbPolyline")

      (cons 90 (length hullList))

      '(70 . 1)

      )

    )

   

  (setq vtxlist (mapcar '(lambda (coord) (cons 10 coord)) hullList))

  (setq Polylist (append Polylist vtxList))

  (entmake PolyList)

)

 





;;=====================================================



  (command "._undo" "_begin")

  (if (tblsearch "UCS" "ConvexHull2D")

      (command "._UCS" "_save" "ConvexHull2D" "_y")

      (command "._UCS" "_save" "ConvexHull2D")

      )

  (getPointList)

  (getBasePoint)

  (setq *ucsicon (getvar "ucsicon"))

  (setvar "ucsicon" 0) 



  (while (not (equal basepoint p3))

    (findSmallestAngle)

    (setq hullList (cons p3 hullList))

;    (command "line" (trans p1 0 1) (trans p3 0 1) "")

    (command "ucs"  (trans p3 0 1) (trans p1 0 1) "")

    (setq p1 p3)

  );while



  (makePolyline)



  (setvar "ucsicon" *ucsicon) 

  (command "._UCS" "_restore" "ConvexHull2D")

  (command "._UCS" "_delete" "ConvexHull2D")

  (command "._undo" "_end")







);defun



(defun c:ch2d () (c:ConvexHull2d))



(princ "ConvexHull2D loaded.  Enter CH2D to run.")

(princ)

[Anonymous]

Hi Bill,

Thanks for sharing.  I just copied your code
into the Vlide, loaded it, and typed CH2D at the command line.  It asked me
to select points so I selected by the Window method.  It crashed.  I
ascertained (Last Break Source) the problem was somewhere in the following
line:

(command "ucs" (trans p3 0 1) (trans p1 0 1)
"")

For what it's worth, both p3 and p1 contained point
values.

Len

style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">

"Bill Gilliss" <
href="mailto:bill@realerthanreal.com">bill@realerthanreal.com> wrote in
message
href="news:6095486@discussion.autodesk.com">news:6095486@discussion.autodesk.com...

Here's a 2D convex hull routine I spent an
enjoyable afternoon on. Draws an LWpolyline parallel to the WCS -- haven't yet
worked out just where to use (trans) to generate the hull parallel to other
UCS's.

-Bill


face="Courier New, Courier, monospace">;|
ConvexHull2D.lsp
draws,
parallel to the WCS, the 2D Least Convex Hull
of a set of POINTs, by the
wrapping method

by Bill Gilliss
bill dot gilliss at
aya.yale.edu
ver 1.0 Dec 24 2008 - initial release

Comments and
suggestions always welcome.
|;

(defun c:ConvexHull2D
  ( /
getPointList getBasePoint findSmallestAngle ptlist hullList pts

       p1 p3
)


;;=====================================================
(defun
getPointList ( / n )
  (setq ptlist nil hullList nil)
 
(prompt "Select points: ")
  (setq pts (ssget '((0 .
"POINT"))))
  (setq n 0)
  (while (< n (sslength
pts))
    (setq ptlist (cons (cdr (assoc 10 (entget (ssname
pts n)))) ptlist))
    (setq n (1+ n))
   
)
)

;;=====================================================
(defun
getBasePoint ( / n en ed enx eny xmax ymax)
  (setq n 0)
 
(while
    (< n (sslength pts))
   
(setq en (ssname pts
n)
          ed (entget
en)
          enx (cadr 
(assoc 10 ed))
          eny
(caddr (assoc 11
ed))
         
)
    (if (= n 0)

        (setq basepoint en  xmax
enx  ymax eny)
       
(if
          (> enx
xmax)
          (setq
basepoint en  xmax enx  ymax
eny)
         
(if
            
(and (equal enx
xmax)
                 
(> eny
ymax)
                 
)
            
(setq basepoint en  xmax enx  ymax
eny)
            
);if
          
);if
       
);if

     (setq n (1+ n))
  
);while
  (setq basepoint (cdr (assoc 10 (entget
BasePoint))))
  (setq p1 basepoint)
  (setq p3
nil)
)


(defun findSmallestAngle ( / n p2 smallestAng) 

  (setq smallestAng (* 2 pi))
  (setq n 0)
 
(while
    (< n (length ptlist))
   
(setq p2 (nth n ptlist))
    (if
(and
          (not (equal p1
p2))
          (not (member p2
hullList))
         
)
     
(progn
        (setq ang (angle (trans
p1 0 1) (trans p2 0 1)))
        (if
(and
             
(< ang
smallestAng)
             
(not (equal ang 0.0
1e-12))
             
)
            (setq
smallestAng ang   p3
p2)
           
)
       
)
      )
    (setq n (1+
n))
    );while
 
)

;;============================================ 
(defun
makePolyline () 
  (setq polylist
    (list

      '(0 . "LWPOLYLINE")

      '(100 . "AcDbEntity")

      '(100 .
"AcDbPolyline")
      (cons 90 (length
hullList))
      '(70 .
1)
      )
   
)
   
  (setq vtxlist (mapcar '(lambda (coord)
(cons 10 coord)) hullList))
  (setq Polylist (append Polylist
vtxList))
  (entmake PolyList)
)
 



;;=====================================================

 
(command "._undo" "_begin")
  (if (tblsearch "UCS" "ConvexHull2D")

      (command "._UCS" "_save" "ConvexHull2D"
"_y")
      (command "._UCS" "_save"
"ConvexHull2D")
      )
 
(getPointList)
  (getBasePoint)
  (setq *ucsicon (getvar
"ucsicon"))
  (setvar "ucsicon" 0) 

  (while (not
(equal basepoint p3))
   
(findSmallestAngle)
    (setq hullList (cons p3
hullList))
;    (command "line" (trans p1 0 1) (trans p3 0
1) "")
    (command "ucs"  (trans p3 0 1) (trans p1 0
1) "")
    (setq p1 p3)
  );while

 
(makePolyline)

  (setvar "ucsicon" *ucsicon) 
 
(command "._UCS" "_restore" "ConvexHull2D")
  (command "._UCS"
"_delete" "ConvexHull2D")
  (command "._undo"
"_end")



);defun

(defun c:ch2d ()
(c:ConvexHull2d))

(princ "ConvexHull2D loaded.  Enter CH2D to
run.")
(princ)

[Anonymous]

Fatfreek wrote:

Hi Bill,

Thanks for sharing.  I just copied
your code into the Vlide, loaded it, and typed CH2D at the command
line.  It asked me to select points so I selected by the Window
method.  It crashed.  I ascertained (Last Break Source) the problem
was somewhere in the following line:

(command "ucs" (trans p3 0 1) (trans
p1 0 1) "")

Thanks for the feedback.



Here is a much faster and more reliable version:  (command "UCS" ...)
calls have been eliminated and point list pruning has upped performance
by about 4x. 5000 points in just over 2 seconds. Not too shabby.



I still need to localize the variables and add error handling, but it
is pretty unobtrusive code -- only plays with cmdecho.



I've been testing it hard all evening (note to self: get a life!), so
now it is your turn. Let me know how it goes.



-Bill





;|

ConvexHull2D.lsp

draws the Least Convex Hull of a set of POINTs as a 2D polyline

in the *current* UCS.



by Bill Gilliss

bill dot gilliss at aya.yale.edu

ver 1.0 Dec 25 2008 - initial release



Notes:

  - The routine will generate different hulls for different UCS's, so is

      most useful when in PLAN view for the current UCS.

  - Points may be 2D or 3D - Z coordinate is ignored. Polyline is drawn
in

      current XY plane.

  - Uses the wrapping method, starting from the farthest right point.

  - Pruning that eliminates most interior points before analysis
results in

      approx 4x speed increase.



Comments and suggestions always welcome.

|;







;;=====================================================

(defun getPointList ( / n )

  (setq ptlist nil hull nil)

  (prompt "Select points: ")

  (setq pts (ssget '((0 . "POINT"))))

  (setq n 0)

  (while (< n (sslength pts))

    (setq pt (cdr (assoc 10 (entget (ssname pts n)))))

    (setq pt (trans pt 0 1))

    (setq pt (list (car pt) (cadr pt)))

    (setq ptlist (cons pt ptlist))

    (setq n (1+ n))

    )

)



;;=====================================================

(defun getNEWSPoints ( / n en ed enx eny xmax ymax)

  (setq n 0)

  (setq pt (nth n ptlist) ptx (car pt) pty (cadr pt))

  (setq eastPt pt

        xmax ptx

        ymax pty

        xmin ptx

        ymin pty)



  (setq n 1)

  (while

    (< n (length ptlist))

    (setq pt (nth n ptlist) ptx (car pt) pty (cadr pt))

    (if (> ptx xmax)

        (setq EastPt  pt xmax ptx)

        (if (< ptx xmin)

          (setq WestPt  pt xmin ptx)

          )

      )

    (if (> pty ymax)

        (setq NorthPt pt ymax pty)

        (if (< pty ymin)

            (setq SouthPt pt ymin pty)

            )

      )

     (setq n (1+ n))

   );while

)





(defun findMinAngle ( / n p2 ang minAng )

    (setq p3 temp)

    (setq minAng 2pi n 0)

    (while  ;;optimize this loop as much as possible

      (< n (length ptlist))

      (setq p2 (nth n ptlist))

      (if (not (equal p2 p1))

        (progn

          (setq ang (rem (+ 2pi (angle p1 p2) (- prevang)) 2pi))

          (if (and (< ang minAng) (not (equal ang 0.0 1e-12)))

              (setq minAng ang  p3 p2 )

              )

          )

        )

      (setq n (1+ n))

      );while



      (setq hull (cons p3 hull))

      (setq prevang (angle p3 p1))

      (command "._line" p1 p3 "")

      (ssadd (entlast) lines)

      (setq temp p1 p1 p3)

)



(defun prunePoints ( / NP SP EP WP p1 p2 p3)

  (setq NP northPt  EP eastPt  WP westPt  SP southPt)

  (setq NEWSpts (list NP EP WP SP))



  ;;prune north half

    (setq p1 EP p2 NP p3 WP)

    (prune)

  ;;prune south half

    (setq p1 WP p2 SP p3 EP)

    (prune)



  (if (or (equal EP NP)

          (equal NP WP)

          (equal WP SP)

          (equal SP EP)

          )

    (progn

   ;;prune west half

    (setq p1 NP p2 WP p3 SP)

    (prune)

  ;;prune east half

    (setq p1 SP p2 EP p3 NP)

    (prune)

    );progn

  );if

)



(defun prune ()

  (if (and (/= p1 p2) (/= p2 p3))

    (progn

      (setq TriangleArea (area3p p1 p2 p3))

      (foreach pt ptlist

        (progn

          (setq testArea

            (+

              (area3p p1 p2 pt)

              (area3p p2 p3 pt)

              (area3p p3 p1 pt)

              )

            )

          (if

            (and

              (not (member pt NEWSpts))

              (equal testArea TriangleArea 1e-8)

              )

            (setq ptlist (vl-remove pt ptlist))

            )

         );progn

       )

      );progn

    );if

)



(defun area3p (p1 p2 p3 / a b c s)

    (setq

        a (distance p1 p2)

        b (distance p2 p3)

        c (distance p3 p1)

        s (* 0.5 (+ a b c))

    )

    (sqrt

        (*

            s

            (- s a)

            (- s b)

            (- s c)

        )

    )

)



;;=========== main routine =========================

(defun c:ConvexHull2D () ;( / ptlist hull pts p1 p3 2pi)

  (setq 2pi (* 2 pi))

  (setq *cmdecho (getvar "cmdecho"))

  (setvar "cmdecho" 0)

  (command "._undo" "_begin")

  (setq hull nil)

  (setq lines (ssadd))

  (getPointList)

  (getNEWSPoints)



  (setq startTime (* 86400 (getvar "tdusrtimer")))



  (prunePoints)



  (setq p1 eastPt)

  (setq hull (cons p1 hull))

  (setq p3 (list (car p1) (1- (cadr p1))) temp p3)

  (setq prevang (angle p1 p3))



  (while (not (equal p3 eastPt)) ;;i.e., continue until closure

    (findMinAngle)

      );while

  (setq endTime (* 86400 (getvar "tdusrtimer")))



  (command "pedit" (entlast) "_join" lines "" "_x")

  (command "._redraw")

  (command "._undo" "_end")

  (setvar "cmdecho" *cmdecho)

  (princ (strcat "elapsed time: " (rtos (- endtime startTime))))

  (princ)

);defun



(defun c:ch2d () (c:ConvexHull2d))



(princ "ConvexHull2D loaded.  Enter CH2D to run.")

(princ)

[Anonymous]

Bill,

This is my 3rd try at responding. This time, I
won't attach the drawing (the server may be rejecting it) of scattered
points.

Your routine draws single lines through the
outermost points, then halts at the following line:

(command "pedit" (entlast) "_join" lines ""
"_x")

Len

style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">

"Bill Gilliss" <
href="mailto:bill@realerthanreal.com">bill@realerthanreal.com> wrote in
message
href="news:6095544@discussion.autodesk.com">news:6095544@discussion.autodesk.com...

Fatfreek wrote:

Hi Bill,

Thanks for sharing.  I just copied your
code into the Vlide, loaded it, and typed CH2D at the command line.  It
asked me to select points so I selected by the Window method.  It
crashed.  I ascertained (Last Break Source) the problem
was somewhere in the following line:

(command "ucs" (trans p3 0 1) (trans p1 0 1)
"")

Thanks for the feedback.

Here
is a much faster and more reliable version:  (command "UCS" ...) calls
have been eliminated and point list pruning has upped performance by about 4x.
5000 points in just over 2 seconds. Not too shabby.

I still need
to localize the variables and add error handling, but it is pretty unobtrusive
code -- only plays with cmdecho.

I've been testing it hard all evening
(note to self: get a life!), so now it is your turn. Let me know how it
goes.

-Bill



face="Courier New, Courier, monospace">;|
ConvexHull2D.lsp
draws the
Least Convex Hull of a set of POINTs as a 2D polyline
in the *current*
UCS.

by Bill Gilliss
bill dot gilliss at aya.yale.edu
ver 1.0 Dec
25 2008 - initial release

Notes:
  - The routine will generate
different hulls for different UCS's, so is
     
most useful when in PLAN view for the current UCS.
  - Points may be
2D or 3D - Z coordinate is ignored. Polyline is drawn
in
      current XY plane.
  - Uses the
wrapping method, starting from the farthest right point.
  - Pruning
that eliminates most interior points before analysis results
in
      approx 4x speed increase.

Comments
and suggestions always
welcome.
|;



;;=====================================================
(defun
getPointList ( / n )
  (setq ptlist nil hull nil)
  (prompt
"Select points: ")
  (setq pts (ssget '((0 . "POINT"))))
 
(setq n 0)
  (while (< n (sslength pts))
   
(setq pt (cdr (assoc 10 (entget (ssname pts n)))))
    (setq
pt (trans pt 0 1))
    (setq pt (list (car pt) (cadr
pt)))
    (setq ptlist (cons pt
ptlist))
    (setq n (1+ n))
   
)
)

;;=====================================================
(defun
getNEWSPoints ( / n en ed enx eny xmax ymax)
  (setq n 0)
 
(setq pt (nth n ptlist) ptx (car pt) pty (cadr pt))
  (setq eastPt
pt
        xmax
ptx
        ymax
pty
        xmin
ptx
        ymin pty)

 
(setq n 1)
  (while
    (< n (length
ptlist))
    (setq pt (nth n ptlist) ptx (car pt) pty (cadr
pt))
    (if (> ptx
xmax)
        (setq EastPt  pt xmax
ptx)
        (if (< ptx
xmin)
          (setq
WestPt  pt xmin
ptx)
         
)
      )
    (if (> pty
ymax)
        (setq NorthPt pt ymax
pty)
        (if (< pty
ymin)
           
(setq SouthPt pt ymin
pty)
           
)
      )
     (setq n (1+
n))
   );while
)


(defun findMinAngle ( / n p2 ang
minAng )
    (setq p3 temp)
    (setq
minAng 2pi n 0)
    (while  ;;optimize this loop as
much as possible
      (< n (length
ptlist))
      (setq p2 (nth n
ptlist))
      (if (not (equal p2
p1))
       
(progn
          (setq ang
(rem (+ 2pi (angle p1 p2) (- prevang))
2pi))
          (if (and (<
ang minAng) (not (equal ang 0.0
1e-12)))
             
(setq minAng ang  p3 p2
)
             
)
         
)
       
)
      (setq n (1+
n))
     
);while

      (setq hull (cons p3
hull))
      (setq prevang (angle p3
p1))
      (command "._line" p1 p3
"")
      (ssadd (entlast)
lines)
      (setq temp p1 p1
p3)
)

(defun prunePoints ( / NP SP EP WP p1 p2 p3)
  (setq
NP northPt  EP eastPt  WP westPt  SP southPt)
  (setq
NEWSpts (list NP EP WP SP))

  ;;prune north
half
    (setq p1 EP p2 NP p3 WP)
   
(prune)
  ;;prune south half
    (setq p1 WP p2 SP
p3 EP)
    (prune)

  (if (or (equal EP
NP)
          (equal NP
WP)
          (equal WP
SP)
          (equal SP
EP)
         
)
    (progn
   ;;prune west
half
    (setq p1 NP p2 WP p3 SP)
   
(prune)
  ;;prune east half
    (setq p1 SP p2 EP p3
NP)
    (prune)
    );progn
 
);if
)

(defun prune ()
  (if (and (/= p1 p2) (/= p2
p3))
    (progn
      (setq
TriangleArea (area3p p1 p2 p3))
      (foreach pt
ptlist
       
(progn
          (setq
testArea
           
(+
             
(area3p p1 p2
pt)
             
(area3p p2 p3
pt)
             
(area3p p3 p1
pt)
             
)
           
)
         
(if
           
(and
             
(not (member pt
NEWSpts))
             
(equal testArea TriangleArea
1e-8)
             
)
            (setq
ptlist (vl-remove pt
ptlist))
           
)
        
);progn
      
)
      );progn
   
);if
)

(defun area3p (p1 p2 p3 / a b c s)
   
(setq
        a (distance p1
p2)
        b (distance p2
p3)
        c (distance p3
p1)
        s (* 0.5 (+ a b
c))
    )
    (sqrt
   
    (*
       
    s
       
    (- s a)
       
    (- s b)
       
    (- s c)
       
)
    )
)

;;=========== main routine
=========================
(defun c:ConvexHull2D () ;( / ptlist hull pts p1
p3 2pi)
  (setq 2pi (* 2 pi))
  (setq *cmdecho (getvar
"cmdecho"))
  (setvar "cmdecho" 0)
  (command "._undo"
"_begin")
  (setq hull nil)
  (setq lines (ssadd))
 
(getPointList)
  (getNEWSPoints)

  (setq startTime (*
86400 (getvar "tdusrtimer")))

  (prunePoints)

  (setq
p1 eastPt)
  (setq hull (cons p1 hull))
  (setq p3 (list (car
p1) (1- (cadr p1))) temp p3)
  (setq prevang (angle p1
p3))

  (while (not (equal p3 eastPt)) ;;i.e., continue until
closure
    (findMinAngle)
     
);while
  (setq endTime (* 86400 (getvar "tdusrtimer")))

 
(command "pedit" (entlast) "_join" lines "" "_x")
  (command
"._redraw")
  (command "._undo" "_end")
  (setvar "cmdecho"
*cmdecho)
  (princ (strcat "elapsed time: " (rtos (- endtime
startTime))))
  (princ)
);defun

(defun c:ch2d ()
(c:ConvexHull2d))

(princ "ConvexHull2D loaded.  Enter CH2D to
run.")
(princ)

[Anonymous]

Fatfreek wrote:

Bill,

This is my 3rd try at responding.
This time, I won't attach the drawing (the server may be rejecting it)
of scattered points.

Your routine draws single lines
through the outermost points, then halts at the following line:

(command "pedit" (entlast) "_join"
lines "" "_x")

Len

Len -



One more time -- we must have different setting for PEDITACCEPT. The
attached should take care of that.



- Bill

[Anonymous]

Bill,

It went through without a hitch this time,
producing a polyline that connected points on the periphery of a pattern of
points.

Not knowing what your scheme is, it appears that it
can be likened to a board with a bunch of pins protruding;  then taking a
string and simply wrapping that string around the outermost pins.  Is that
a correct assessment?

Len

style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">

"Bill Gilliss" <
href="mailto:bill@realerthanreal.com">bill@realerthanreal.com> wrote in
message
href="news:6095635@discussion.autodesk.com">news:6095635@discussion.autodesk.com...

Fatfreek wrote:

Bill,

This is my 3rd try at responding. This time, I
won't attach the drawing (the server may be rejecting it) of scattered
points.

Your routine draws single lines through the
outermost points, then halts at the following line:

(command "pedit" (entlast) "_join" lines ""
"_x")

Len

Len
-

One more time -- we must have different setting for PEDITACCEPT. The
attached should take care of that.

-
Bill

[Anonymous]

Fatfreek wrote:

Bill,

It went through without a hitch this
time, producing a polyline that connected points on the periphery of a
pattern of points.

Not knowing what your scheme is, it
appears that it can be likened to a board with a bunch of pins
protruding;  then taking a string and simply wrapping that string
around the outermost pins.  Is that a correct assessment?

Len

Exactly. It implements the algorithm known as Jarvis's March, because
we march around the set of points, finding successive hull vertices in
order.



The trick, of course, is how to "simply" determine which are the
outermost points -- a string or a rubber band will do it essentially
instantaneously, because they ignore all of the internal points. Not
being that smart, a computer must inspect each point in the set all
over again for each new line segment to find the one that makes the
least angle with the previous segment. I did add a pruning routine to
eliminate from consideration points that are definitely interior.



Another much slower method would be to create a triangle of
every possible combination of three points, make them all regions, then
union the regions. You do not want to go there with large numbers of
points.



There are several other algorithms for determining the convex hull of a
set of points. For animated versions of  some of them, see
http://www.cs.princeton.edu/~ah/alg_anim/version1/JarvisMarch.html

and follow the link to Quick-hull and from there to Graham's Scan.

[_gile]

Hi,

Here's another way (not deeply tested)

{code}(defun c:test (/ xmin angmax ss n pt pts minx res new)

(defun xmin (pts / res xm)
(setq res (car pts)
xm (car res)
)
(while (setq pts (cdr pts))
(if (< (caar pts) xm)
(setq res (car pts)
xm (car res)
)
)
)
res
)

(defun angmax (start end pts / a0 a1 tmp)
(setq a0 (angle start end)
a1 0.0
)
(while pts
(setq tmp (ang<2pi (- a0 (angle start (car pts)))))
(if (< a1 tmp)
(setq a1 tmp
pt (car pts)
)
)
(setq pts (cdr pts))
)
pt
)

(if (setq ss (ssget '((0 . "POINT"))))
(progn
(setq n -1)
(while (setq pt (ssname ss (setq n (1+ n))))
(setq pt (cdr (assoc 10 (entget pt)))
pts (cons (list (car pt) (cadr pt)) pts)
)
)
(setq minx (xmin pts)
res (cons (angmax minx (list (car minx) (+ (cadr minx) 1)) pts)
(cons minx res)
)
pts (vl-remove (car res) pts)
)
(while
(not
(equal (setq new (angmax (car res) (cadr res) pts))
minx
1e-9
)
)
(setq res (cons new res)
pts (vl-remove pt pts)
)
)
(entmakex
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length res))
'(70 . 1)
)
(mapcar '(lambda (p)
(cons 10 p)
)
res
)
)
)
)
)
(princ)
)

;;; Ang<2pi (gile)
;;; Returns the angle expression between 0 and 2pi
;;;
;;; Argument : an angle (radian)

(defun ang<2pi (ang)
(if (and (<= 0 ang) (< ang (* 2 pi)))
ang
(ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
)
){code} Edited by: _gile on Dec 26, 2008 8:56 PM

[Anonymous]

Hi, gile -

Same basic algorithm, but as usual, your code is 4 times as fast and 1/4
as long as the best I can manage.

I don't know whether to give up or keep trying. I am in awe.

Joyeux Noël et Bonne Année!

-Bill