intersection

[maahee]

(defun C:BM ()
  (setq poly (car (entsel "\nSelect any LWpolyline (for offset)..."))) 
  (setq line (car (entsel "\nSelect a line to break...")))
  (setq dist (getreal "\nEnter the offset distance: "))
  (setq g (getreal "\nEnter the gap: "))

  (if (and poly line)  ; Ensure both selections are made
    (progn 
     
      (setq pdb (entget poly)) 
      (if (= (cdr (assoc 0 pdb)) "LWPOLYLINE")  ; Check if the entity type is LWPOLYLINE
        (progn 
          (setq ps '())
          (setq pt1 nil)

          ;; Extract vertex points from the polyline
          (foreach sublist pdb
            (if (= (car sublist) 10)  ; Look for vertex points (coded as 10)
              (if (null pt1)
                (setq pt1 (cdr sublist))  ;; First vertex
                (progn
                  (setq pt2 (cdr sublist))  ;; Next vertex
                  (setq ps (append ps (list pt1 pt2)))  ; Append points to the list
                  (setq pt1 pt2) ;; Update pt1 for the next iteration
                )
              )
            )
          )

          
          (command "_.offset"  dist poly "@1<90" "")

          ;; Get the start and end points of the line
          (setq typ (entget line))
          (setq p1 (cdr (assoc 10 typ)))  ; Start point of the line
          (setq p2 (cdr (assoc 11 typ)))  ; End point of the line
          
          ;; Find intersection point
          (setq kl (inters p1 p2 (nth 0 ps) (nth 1 ps)))  
          
          (if kl
            (progn
              (command "_break" poly kl (mapcar '+ kl (list g 0 0)))
              (command "line" kl (mapcar '+ kl (list g 0 0)) "")
            )
            (prompt "\nNo intersection found.")
          )
        ) ;; End progn for LWPOLYLINE
      ) ;; End if for LWPOLYLINE type
    ) ;; End progn for both selections
    (prompt "\nPlease select both a polyline and a line.")
  ) ;; End if for selection
) ;; End defun

I can not find the intersection point polyline in blue and line red colors. gives suggestion and ideas

1l.pdf

Edited March 3 by maahee

[GLAVCVS]

The answer is simple: the first segment of the polyline does not intersect the line.
If, at first glance, you can see that the line intersects the polyline, it means that it does so in another segment, but not in the first one.

[GLAVCVS]

Your code should advance through the list of points on the polyline until it finds the segment that intersects the line.

[GLAVCVS]

But there is another, simpler way to get the intersection, which makes the part of your code that gets the lists of points unnecessary: 'vla-intersectWith'
Simply replace the line of code that starts with '(setq kl (inters ...))' with... 

(setq kl (safearray-value (variant-value (vla-intersectWith (vlax-ename->vla-object poly) (vlax-ename->vla-object line) 0))))

 

[BIGAL]

A couple of ideas use a (ssget "F" where you drag a line through all the red cut lines this should return them in correct order, pick pline, do offset, and then as suggested can do the pairs break. I would also check is the number of cut lines even if not then dont run. You need to do the break twice inner and outer pline so 4 points can then cap as well. 

 

Will have a think about it.

 

Just a ps 

(setq intpt1 (vlax-invoke obj2 'intersectWith obj acextendnone))
returns
(58.111571345732 222.717516115398 0.0)

No need for the safe array

 

[maahee]

selection method for the correct order, ssget "F" effectively works but it has some limitations I am using this (setq ss (ssget)) method then separate line and polyline 

1l.pdf

Edited Thursday at 02:02 PM by maahee

[BIGAL]

Give this a try, it has the sort selection order using fence, it has no error checking, relies on the pline on a different layer to the cut lines. It also caps the ends I guess you want to make all the bits into a pline.

; https://www.cadtutor.net/forum/topic/96685-intersection/
; do by fence a 1st attempt by AlaH March 2025

(defun c:pltrim ( / plent co-ord obj obj2 ss intpt dist lst osnap lay lay2)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(setq lst '())
(setq off (getreal "\nEnter offset value "))
(princ "\nPick points for fence line selection ")
(command-s "pline")
(setq plent (entlast))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent))))
(command "erase" plent "")
(setq ss (ssget "F" co-ord '((0 . "LINE"))))
(setq lay (cdr (assoc 8 (entget (ssname ss 0)))))
(if (= (getvar 'clayer) lay)
  (command "-layer" "off" lay "Y" "")
  (command "-layer" "off" lay "")
)

(setq plent (car (entsel "\nPick polyline ")))
(setq obj (vlax-ename->vla-object plent))
(setvar 'clayer (vlax-get obj 'layer))

(repeat (setq x (sslength ss))
  (setq l2 (ssname ss (setq x (1- x))))
  (setq obj2 (vlax-ename->vla-object l2))
  (setq intpt (vlax-invoke obj 'intersectwith obj2 acextendnone))
  (setq dist (vlax-curve-getdistatpoint obj intpt))
  (setq lst (cons (list dist intpt ) lst))
)

(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))

(setq x 0)
(setq lst2 '())
(setq lst2 (cons plent lst2))
(setq pt1 (cadr (nth x lst)))
(setq pt2 (cadr (nth (1+ x) lst)))
(command "break" pt1 pt2)
(setq x (+ x 2))
(repeat (- (/ (length lst) 2) 1)
  (setq pt1 (cadr (nth x lst)))
  (setq pt2 (cadr (nth (1+ x) lst)))
  (command "break" pt1 pt2)
  (setq lst2 (cons (entlast) lst2))
  (setq x (+ x 2))
)


(foreach ent lst2
  (setq eobj (vlax-ename->vla-object ent))
  (vla-offset eobj off)
  (setq nobj (vlax-ename->vla-object  (entlast)))
  (setq s2 (vlax-curve-getstartPoint nobj))
  (setq e2 (vlax-curve-getendpoint nobj))
  (setq s1 (vlax-curve-getstartpoint eobj))
  (setq e1 (vlax-curve-getendpoint eobj))
  (command "line" s1 s2 "")
  (command "line" e1 e2 "")
)

(command "-layer" "on" lay "")
(setvar 'osmode oldsnap)

(princ)
)

 

Edited Friday at 04:41 AM by BIGAL