Segmenting Polyline at Nearest Block When Length Limit Reached

[Anushka]

I have a function that draws a polyline along the shortest path through a series of points. I've managed to modify it to break the polyline when it reaches the maximum bobbin length. However, I need help refining the function so that when the maximum length is reached, it segments the polyline at the nearest block point within the point list (plist). Additionally, if the gap between points in plist is greater than the bobbin length, the function should add a new segment without aligning exactly with a plist point. How can I perform this check and adjustment efficiently?

 

; ;; Routine to draw a polyline along the shortest route from
; ;; any starting point through selected circles or inserts in Modelspace
; ;; John Uhden (07-22-18)
; ;; Rev. (11-25-18) to include inserts and selection.
(defun c:OTIMIZEROTA ( / ss i p plist route @closer compbobina comprimento-atual pnt-segmento)
  ;; Função para encontrar o ponto mais próximo na lista
  (defun @closer (a b c) (< (distance a b) (distance a c)))
  ;; Seleção dos blocos e entrada do ponto inicial
  (and
    (setq ss (ssget '((0 . "INSERT"))))
    (setq p (getpoint "\nSelect or specify the starting point - use osnap CEN or INS: "))
    (setq compbobina (getreal "\nCoil length: "))
    (foreach i (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq ent i)
      (setq obj (vlax-ename->vla-object ent))
      (setq pnt (vlax-get obj 'insertionpoint))
      (setq rot (vlax-get obj 'Rotation))
      (setq _pnt (polar pnt (+ rot (* 0.5 pi)) 3.57403916))
      (setq plist (cons _pnt plist))
    )

    (setq comprimento-atual 0)
    (while plist
      (setq route (list p)) 
      (setq comprimento-atual 0)
      (while (and plist (< comprimento-atual compbobina))
        (setq pnt-segmento (car (vl-sort plist '(lambda (a b) (@closer p a b)))))
        (setq nova-distancia (distance p pnt-segmento))
        (if (<= (+ comprimento-atual nova-distancia) compbobina)
          (progn
            (setq route (cons pnt-segmento route))
            (setq comprimento-atual (+ comprimento-atual nova-distancia))
            (setq p pnt-segmento
                  plist (vl-remove pnt-segmento plist)))
          (progn
            (setq p (polar p (angle p pnt-segmento) (- compbobina comprimento-atual)))
            (setq route (cons p route))
            (setq comprimento-atual compbobina)
          )
        )
      )
      (setvar "osmode" 0)
      (setvar "cmdecho" 0)
      (vl-cmdf "_.pline")
      (mapcar 'vl-cmdf (reverse route))
      (vl-cmdf "")
      (vl-cmdf "_.point" p)
    )
  )
  (princ)
)

 

[BIGAL]

Just one suggestion

 

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 68)
(setq p (getpoint "\nSelect or specify the starting point: "))
.......... code
(setvar 'osmode oldsnap)
(princ)
)

 

A dwg may help with before and after examples.

[Anushka]

@BIGALThank you for your feedback. Let me try to explain better, as it may not have been clear before.

Currently, your code is generating results in a way that doesn't seem to make much sense:

My code is segmenting at the correct length, however it does not follow the desired split points, so it does not align the break directly over the block.

 

 

The goal is this:
If the length between two spans exceeds the length of the coil, it must be segmented. The coil must always end in a block. If the next block exceeds the length limit, it must break at the previous block.

 

I've tried several codes, but I still haven't been able to implement this check correctly. Thanks in advance for your help!

coil.dwg

[BIGAL]

I would draw a single pline as the first step, that touches say the insertion point of your block.

 

Try this will break the pline at length 90. It does not fix your find blocks.

 

(defun c:coil ( / ent obj len coil)
(setq ent (car (entsel "\nPick object ")))
(setq obj (vlax-ename->vla-object ent))
(setq len (vlax-get obj 'length))
(setq coil 90.0)

(setvar 'pdmode 34)

(while (> len 90)
  (setq pt (vlax-curve-getpointatdist obj coil))
  (command "Break"  pt pt)
  (setq ent (entlast))
  (setq obj (vlax-ename->vla-object ent))
  (setq len (vlax-get obj 'length))
  (command "point" pt)
)

(princ)
)
(c:coil)

 

Edited November 6, 2024 by BIGAL