Topic: Flexible function for getting vertices of polyline

[EWCAD]

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.

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)
)










[BIGAL]

Try this yes does add a midpoint on lines but if its not a problem use it.

Code: [Select]

; By Kent Cooper
; March 2014

(setq
  pl (car (entsel "\nSelect Polyline: "))
  endpar (fix (vlax-curve-getEndParam pl))
  step 0
  ptlist (list (vlax-curve-getStartPoint pl))
)
(repeat
  (if (vlax-curve-isClosed pl)
    (1- (* endpar 2))
    (* endpar 2)
  )
  (setq ptlist
    (cons (vlax-curve-getPointAtParam pl (setq step (+ step 0.5))) ptlist)
  )
)
(setq ptlist (cons (last ptlist) ptlist))

; find left most corner with a sort
; By Dexus NOV 2022

(defun rotate-rectange (lst / corner)
  (setq corner
    (car
      (vl-sort lst
        (function
          (lambda (a b)
            (if (equal (car a) (car b) 1e-4)
              (< (cadr a) (cadr b))
              (< (car a) (car b))
            )
          )
        )
      )
    )
  )
  (while (/= (car lst) corner) ; rotate until corner is the first item
    (setq lst (append (cdr lst) (list (car lst))))
  )
  lst
)
 
(setq lst2 (rotate-rectange ptlist))