Automating drawing polylines using Points

[Kablamtron]

Hello Everyone!

 

I am using vanilla AutoCad (R14-2012) and was wondering what the best solution would be for this problem (other than manually drawing each outline which I currently do!)

 

I am looking to draw polylines along each point creating a polyline outline (perimeter) around the selected points. This in itself is quite difficult to do well(haven't found a great method yet) but there are multiple groups of points that I would like polylines around without selecting each individual group of points (in an ideal world).

 

I realize that getting something 100% right is impossible and some manual editing (maybe a lot!) will be required.

 

Attached is a sample of the points I usually have to work with.

 

Test 05 2013.dwg

 

I have done a bit of research and found some close solutions which I will post below.

 

1. Draw the polyline by point ID (can't remember author)

 

(vl-load-com)
;;; to make a 3d polyline*******************************************
(defun c:pol (/ adoc spc ss cnt plst 3dline)
(setq adoc(vla-get-activedocument(vlax-get-acad-object)))
(setq spc(vlax-get adoc
(if (equal (getvar "cvport") 1)
'PaperSpace
'ModelSpace
);_if
)
);_setq
(setq ss (ssget '((0 . "POINT"))));_select only point objects
(if ss
(progn
(setq cnt 0);_loop counter
(setq plst '());_empty list
  (while (< cnt (sslength ss))
(setq plst (cons(cdr(assoc 10(entget (ssname ss cnt))))plst));_make point list
(setq cnt (1+ cnt));_incerase counter
    );_while
(setq 3dline (vla-add3dpoly ;_make 3d polyline 
      spc
      (vlax-safearray-fill
 (vlax-make-safearray vlax-vbDouble
 (cons 0 (1- (length (apply 'append plst)))))
 (apply 'append plst)))
      );_setq add 3dpoly
);_progn
);_if
(princ)
  );_defun
;;; to make a 3d  spline******************************************
(defun c:spl (/ adoc spc ss cnt plst 3dline stpt ept)
(setq adoc(vla-get-activedocument(vlax-get-acad-object)))
(setq spc(vlax-get adoc
(if (equal (getvar "cvport") 1)
'PaperSpace
'ModelSpace
);_if
)
);_setq
(setq ss (ssget '((0 . "POINT"))))
(if ss
(progn
(setq cnt 0);_loop counter
(setq plst '());_empty list
  (while (< cnt (sslength ss))
(setq plst (cons(cdr(assoc 10(entget (ssname ss cnt))))plst))
(setq cnt (1+ cnt));_incerase counter
    );_while
(setq stpt (vlax-3d-point '(0.0 0.0 0.0)));_start pt for spline
(setq ept (vlax-3d-point '(0.0 0.0 0.0)));_end pt for spline
(setq cline (vla-addspline
      spc
      (vlax-safearray-fill
 (vlax-make-safearray vlax-vbDouble
 (cons 0 (1- (length (apply 'append plst)))))
 (apply 'append plst))
      stpt
      ept
      )
      );_setq add 3d spline
);_progn
);_if
(princ)
  );_defun

 

2. Convex Hull (Lee Mac ftw)

 

;; Convex Hull  -  Lee Mac
;; Implements the Graham Scan Algorithm to return the
;; Convex Hull of a list of points.
(defun LM:ConvexHull ( lst / hul p0 )
   (cond
       (   (< (length lst) 4)
           lst
       )
       (   t
           (setq p0 (car lst))
           (foreach p1 (cdr lst)
               (if (or (< (cadr p1) (cadr p0))
                       (and (equal (cadr p1) (cadr p0) 1e- (< (car p1) (car p0)))
                   )
                   (setq p0 p1)
               )
           )
           (setq lst
               (vl-sort lst
                   (function
                       (lambda ( a b / c d )
                           (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-
                               (< (distance p0 a) (distance p0 b))
                               (< c d)
                           )
                       )
                   )
               )
           )
           (setq hul (list (caddr lst) (cadr lst) (car lst)))
           (foreach pt (cdddr lst)
               (setq hul (cons pt hul))
               (while (and (caddr hul) (LM:Clockwise-p (caddr hul) (cadr hul) pt))
                   (setq hul (cons pt (cddr hul)))
               )
           )
           hul
       )
   )
)
;; Clockwise-p  -  Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented or collinear

(defun LM:Clockwise-p ( p1 p2 p3 )
   (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
           (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
       )
       1e-8
   )
)
(defun c:test1 ( / i l s )
   (if (setq s (ssget '((0 . "POINT"))))
       (progn
           (repeat (setq i (sslength s))
               (setq l (cons (cdr (assoc 10 (entget (ssname s (setq i (1- i)))))) l))
           )
           (setq l (LM:ConvexHull l))
           (entmakex
               (append
                   (list
                      '(0 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                       (cons 90 (length l))
                      '(70 . 1)
                   )
                   (mapcar '(lambda ( x ) (cons 10 x)) l)
               )
           )
       )
   )
   (princ)
)

 

3. Create surfaces out of points using triangulation and limit the length of triangle then use bounding box to create polyline(hard to do in vanilla AutoCad).

 

4. Neat solution shown by Tyke (which I don't have the code for)

 

 

5. Possibly use multiple Bpoly commands, somehow getting the Bpoly command to recongnize points???

 

6. Outsource?

 

Anywho, if you guys have any ideas as to (too?) other methods/possible solutions/software programs/ANYTHING that could be of help that would be awesome!

 

Thanks again for reading,

 

Kablamtron

[BIGAL]

This sounds like something better done a step earlier by using points codes xyz & description "join like" descriptors this is known as stringing CIV3d etc its built in.

[Lee Mac]

I have a program that will generate an LWPolyline outline for a selection of points in the plane, as demonstrated by the following animation using some examples from your file:

 

 

As expected for this form of task, the program does not return what would be considered the 'correct' outline for some point arrangements with tight concave sections, however, the algorithm should produce good results for most general cases.

 

The program is not freeware however, and you may contact me if you are interested.