1
AutoLISP (Vanilla / Visual) / Flexible function for getting vertices of polyline
« Last post by EWCAD on Today at 02:03:53 PM »I have been trying to create a function that will get the vertices of a polyline that has an arc top and sort them clockwise starting from the bottom left. I have on that I use for rectangles but I cant quite wrap my head around how to reliably get the middle "vertice" of the arc segment at the top. I have gotten it to work for certain configurations but when you mirror the shape, it no longer works... I've been at this all day and at this point I think I'm probably over complicating it. For reference I have attached a screen cap with the shapes I'm working with and the points I am wanting to get a list of. (center of arc is a bonus, really only need the middle grip)
Here is my (probably overly complicated) bits of code.
Here is my (probably overly complicated) bits of code.
Code: [Select]
(defun sort-vertices (verts)
(vl-sort verts
'(lambda (a b)
(or (< (cadr a) (cadr b))
(and (= (cadr a) (cadr b)) (< (car a) (car b))))))
)
(defun order-vertices (sorted-verts / bl br top-verts tl tr)
;; Bottom-left and bottom-right vertices
(setq bl (car sorted-verts))
(setq br (car (vl-sort (cdr sorted-verts)
'(lambda (a b) (> (car a) (car b))))))
;; Extract top vertices by removing bottom vertices
(setq top-verts (vl-remove bl sorted-verts))
(setq top-verts (vl-remove br top-verts))
;; Top-left and top-right vertices
(setq tl (car (vl-sort top-verts
'(lambda (a b) (< (car a) (car b))))))
(setq tr (car (vl-remove tl top-verts)))
(list bl tl tr br)
)
(defun midpoint-of-arc (curve-obj start-pt end-pt bulge / start-param end-param mid-param param-range)
(if (/= bulge 0.0)
(progn
(setq start-param (vlax-curve-getParamAtPoint curve-obj start-pt))
(setq end-param (vlax-curve-getParamAtPoint curve-obj end-pt))
;; Handle wrapping around for closed polylines
(if (> start-param end-param)
(setq end-param (+ end-param (vlax-curve-getEndParam curve-obj))))
(setq mid-param (/ (+ start-param end-param) 2))
(vlax-curve-getPointAtParam curve-obj mid-param))
nil)
)
(defun c:SortPolylineVertices (/ ent entType verts midpoints sorted-verts ordered-verts pt index next-pt bulge coords bulges entData numVerts closed tl tr midpoint)
(setq ent (car (entsel "\nSelect polyline: ")))
(setq entType (cdr (assoc 0 (entget ent))))
(if (or (eq entType "LWPOLYLINE") (eq entType "POLYLINE"))
(progn
(setq verts '())
(setq midpoints '())
(setq closed nil)
(setq entObj (vlax-ename->vla-object ent))
(if (eq entType "LWPOLYLINE")
(progn
(setq coords (vlax-get entObj 'Coordinates))
(setq entData (entget ent))
(setq closed (= 1 (logand (cdr (assoc 70 (entget ent))) 1))) ; Check if polyline is closed
(setq numVerts (/ (length coords) 2))
(setq bulges
(mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (eq (car x) 42))
entData)))
(setq index 0)
(while (< index numVerts)
(setq pt (list (nth (* index 2) coords) (nth (+ 1 (* index 2)) coords)))
(setq verts (cons pt verts))
(setq index (1+ index))
)
(setq verts (reverse verts))
)
(progn
(setq entData (entget ent))
(setq verts
(mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (eq (car x) 10))
entData)))
(setq bulges
(mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (eq (car x) 42))
entData)))
(setq closed (= 1 (logand (cdr (assoc 70 (entget ent))) 1))) ; Check if polyline is closed
)
)
(setq sorted-verts (sort-vertices verts))
(setq ordered-verts (order-vertices sorted-verts))
(setq tl (nth 1 ordered-verts)) ; Top-left vertex
(setq tr (nth 2 ordered-verts)) ; Top-right vertex
;; Check bulge for the segment from top-left to top-right
(setq index (1+ (vl-position tl sorted-verts)))
(setq bulge (if (< index (length bulges)) (nth index bulges) 0.0))
;; Calculate the midpoint of the arc
(setq midpoint (midpoint-of-arc entObj tl tr bulge))
(setq midpoints (list midpoint))
(princ "\nOrdered Vertices: ")
(mapcar '(lambda (pt) (princ (strcat "\n" (rtos (car pt) 2 2) ", " (rtos (cadr pt) 2 2)))) ordered-verts)
(princ "\nMidpoints of Arcs: ")
(mapcar '(lambda (pt) (if pt (princ (strcat "\n" (rtos (car pt) 2 2) ", " (rtos (cadr pt) 2 2))))) midpoints)
)
(princ "\nSelected entity is not a polyline.")
)
(princ)
)