FREELISP : Find, mark and count line intersections

     If you want to find, mark and count line intersections, you can let ChatGPT help you code LISP program and run as VDO.

@ptcaduser

PTCAD-Intersect mark #ptcad #lisp #intersection #cad

♬ original sound - ptcaduser

Command : Intcnt

Source code

(defun intersect-line-line (a1 a2 b1 b2 / x1 y1 x2 y2 x3 y3 x4 y4 denom ua ub)
  (setq x1 (car a1) y1 (cadr a1)
        x2 (car a2) y2 (cadr a2)
        x3 (car b1) y3 (cadr b1)
        x4 (car b2) y4 (cadr b2))
  (setq denom (- (* (- x1 x2) (- y3 y4)) (* (- y1 y2) (- x3 x4))))
  (if (not (equal denom 0.0 1e-8))
    (progn
      (setq ua (/ (- (* (- x1 x3) (- y3 y4)) (* (- y1 y3) (- x3 x4))) denom))
      (setq ub (/ (- (* (- x1 x3) (- y1 y2)) (* (- y1 y3) (- x1 x2))) denom))
      (if (and (>= ua 0.0) (<= ua 1.0) (>= ub 0.0) (<= ub 1.0))
        (list (+ x1 (* ua (- x2 x1)))
              (+ y1 (* ua (- y2 y1)))
              0.0)
      )
    )
  )
)
(defun draw-colored-circle (pt rad color)
  (entmakex (list
              (cons 0 "CIRCLE")
              (cons 10 pt)
              (cons 40 rad)
              (cons 62 color))) ; 1 = red
)
(defun c:intcnt ( / ss i j e1 e2 ent1 ent2 ptA1 ptA2 ptB1 ptB2 ip radius count)
  (prompt "\nSelect LINE objects to check intersections: ")
  (setq ss (ssget '((0 . "LINE")))) ; Support LINEs only for now
  (if ss
    (progn
      (initget 7)
      (setq radius (getreal "\nEnter radius for intersection marks: "))
      (setq count 0)
      (setq i 0)
      (while (< i (sslength ss))
        (setq e1 (ssname ss i)
              ent1 (entget e1)
              ptA1 (cdr (assoc 10 ent1))
              ptA2 (cdr (assoc 11 ent1)))
        (setq j (1+ i))
        (while (< j (sslength ss))
          (setq e2 (ssname ss j)
                ent2 (entget e2)
                ptB1 (cdr (assoc 10 ent2))
                ptB2 (cdr (assoc 11 ent2)))
          (setq ip (intersect-line-line ptA1 ptA2 ptB1 ptB2))
          (if ip
            (progn
              (draw-colored-circle ip radius 4) ; cyan
              (setq count (1+ count))
            )
          )
          (setq j (1+ j))
        )
        (setq i (1+ i))
      )
      (prompt (strcat "\nNo. of Intersections: " (itoa count)))
    )
    (prompt "\nNo valid LINE objects selected.")
  )
  (princ)
)