;;Errors on very short gaps
;;Check fuzz factors for small lines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:ss-union ( lst / out ss i a b)
  (setq lst (vl-sort lst '(lambda ( a b ) (> (sslength a) (sslength b)))) )
  (setq out (car lst) )
  (foreach ss (cdr lst)
    (repeat (setq i (sslength ss))
      (ssadd (ssname ss (setq i (1- i))) out)
    )
  )
  out
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun linelength ( AnEnt Fuzz / Result Pt1 Pt2)
  (setq Pt1 (cdr (assoc 10 (entget AnEnt))))
  (setq Pt2 (cdr (assoc 11 (entget AnEnt))))
  (setq Result (distance Pt1 Pt2))
  (if (< Result Fuzz)(setq Result 0))
  Result
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun onlyunique ( MyList / ReturnList n )
  (setq ReturnList (list))                           ; blank list for result
  (foreach n MyList                                  ; loop through supplied list
    (if ( = (member n (cdr (member n MyList))) nil)  ; if list item occurs only once
      (setq ReturnList (append ReturnList (list n))) ; add to list
    )
  ) ; end foreach
  ReturnList
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun uniquepoints ( MySS / MyList acount MyEnt)
  (princ "Select Lines")
  (setq MyList (list))                                 ; Blank list for line coordinates
  (setq acount 0)
  (while (< acount (sslength MySS))                    ; loop each line
    (setq MyEnt (entget (ssname MySS acount)))
    (setq MyList (append MyList (list (cdr (assoc 10 MyEnt))))) ; add end A to list
    (setq MyList (append MyList (list (cdr (assoc 11 MyEnt))))) ; add end B to list
    (setq acount (+ acount 1))
  )
  (list (onlyunique MyList) MyList)                     ; list: Unique Items, All Items
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun 3parc ( pt1 pt2 pt3 / ocs lst ) ; Lee Mac
  (if (setq ocs (trans '(0 0 1) 1 0 t))
      (if (setq lst (LM:3pcircle pt1 pt2 pt3))
          (progn
              (if (minusp (sin (- (angle pt1 pt3) (angle pt1 pt2))))
                  (mapcar 'set '(pt1 pt3) (list pt3 pt1))
              )
              (entmakex
                  (list
                     '(000 . "ARC")
                      (cons 010 (trans (car lst) 1 ocs))
                      (cons 040 (cadr lst))
                      (cons 050 (angle (trans (car lst) 1 ocs) (trans pt1 1 ocs)))
                      (cons 051 (angle (trans (car lst) 1 ocs) (trans pt3 1 ocs)))
                      (cons 210 ocs)
                  )
              )
          )
          (princ "\nPoints are collinear.")
      )
  )
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun BndBx ( EntName AnArea / mn mx) ; Line bounding box, for ssget
  (vla-getboundingbox (vlax-ename->vla-object EntName) 'mn 'mx)
  (setq mn (mapcar '+ (list (* -1 AnArea) (* -1 AnArea) 0) (vlax-safearray->list mn)))
  (setq mx (mapcar '+ (list (*  1 AnArea) (*  1 AnArea) 0) (vlax-safearray->list mx)))
  (list mn mx)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:3pcircle ( pt1 pt2 pt3 / cen md1 md2 vc1 vc2 )
  (if (setq md1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2)
            md2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt2 pt3)
            vc1 (mapcar '- pt2 pt1)
            vc2 (mapcar '- pt3 pt2)
            cen (inters md1 (mapcar '+ md1 (list (- (cadr vc1)) (car vc1) 0))
                        md2 (mapcar '+ md2 (list (- (cadr vc2)) (car vc2) 0))
                        nil
                )
      )
      (list cen (distance cen pt1))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun AdjLines ( MyEnt / FF TheLines Pt1 Pt2 currentzoom No_Mutt Pt1A Pt1B AdjSS DelLines AdjCount NewSel )
;;Set up
  (setq FF 0.0001)                            ; Fuzz Factor
  (setq TheLines (ssadd))                     ; List of connecting lines
  (setq Pt1 (cdr (assoc 10 (entget MyEnt))))  ; End A point
  (setq Pt2 (cdr (assoc 11 (entget MyEnt))))  ; End B point
;; Zoom to line
  (setq currentzoom (list (getvar 'viewctr) (getvar 'viewsize))) ; Current Zoom
  (setq No_Mutt (getvar 'nomutt))(setvar 'NoMutt 1) ; do it quietly
  (vla-ZoomWindow (vlax-get-acad-object)      ; Zoom to line bounding box +/-
    (vlax-3D-point (car  (BNDBX MyEnt (* (linelength MyEnt 0) 0.25))))
    (vlax-3D-point (cadr (BNDBX MyEnt (* (linelength MyEnt 0) 0.25))))
  )
  (setvar 'nomutt No_Mutt)
;; Assess each end
  (repeat 2
    (setq Pt1A (mapcar '+ (list (* FF -1) (* FF -1)) Pt1))  ; Small area around end of line
    (setq Pt1B (mapcar '+ (list (* FF  1) (* FF  1)) Pt1))
    (setq AdjSS (ssget "_C" Pt1A Pt1B '((0 . "LINE"))) )    ; select adjacent lines
    (setq DelLines (ssadd MyEnt))            ; Selection set to exclude some lines
;;Find if any line is very short
    (setq AdjCount 0)
    (while (< AdjCount (sslength AdjSS))
      (if (= (linelength (ssname Adjss AdjCount) 0.0001) 0)
        (setq DelLines (ssadd (ssname Adjss AdjCount) DelLines))
      )
      (setq AdjCount (+ AdjCount 1))
    ) ; end while
;;Delete these lines
    (setq AdjCount 0)
    (while (< AdjCount (sslength DelLines))
      (setq AdjSS (ssdel (ssname DelLines AdjCount) AdjSS))
      (setq AdjCount (+ AdjCount 1))
    ) ; end while
;;Number of intersections
    (cond
      ((= (sslength AdjSS) 0) ; Found one adjacent intersection point
        (progn
        )
      ) ; end cond
      ((= (sslength AdjSS) 1) ; Found one adjacent intersection point
        (setq TheLines (ssadd (ssname AdjSS 0) TheLines))
      ) ; end cond
      (t                      ; All others
        (vla-ZoomWindow (vlax-get-acad-object)
          (vlax-3D-point (mapcar '+ (list (* -1 (distance Pt1 Pt2)) (* -1 (distance Pt1 Pt2))) Pt1) )
          (vlax-3D-point (mapcar '+ (list (*  1 (distance Pt1 Pt2)) (*  1 (distance Pt1 Pt2))) Pt1) )
        )
        (princ "\nToo many line connections, Select a line")
        (redraw MyEnt 3)
        (setq NewSel (car (entsel)))  ;;Error check this is a line
        (redraw MyEnt 4)
        (setq TheLines (ssadd NewSel TheLines))
      )
    ) ; end conds
    (setq Pt1A Pt2)(setq Pt2 Pt1)(setq Pt1 Pt1A) ; swap ends
  ) ; end repeat
  (setq No_Mutt (getvar 'nomutt))(setvar 'NoMutt 1)
  (vla-ZoomCenter (vlax-get-acad-object) (vlax-3d-point (car currentzoom)) (cadr currentzoom))
  (setvar 'nomutt No_Mutt)
  TheLines
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Int ( Ent1 Ent2 / Pt1A Pt1B Pt2A Pt2B PtC MyInt MyRadius )    ; Get intersection
  (setq Pt1A (cdr (assoc 10 (entget Ent1))))   ; End A point
  (setq Pt1B (cdr (assoc 11 (entget Ent1))))   ; End B point
  (setq Pt2A (cdr (assoc 10 (entget Ent2))))   ; End A point
  (setq Pt2B (cdr (assoc 11 (entget Ent2))))   ; End B point
  (if (equal Pt1A Pt2A 0.0001)(setq PtC Pt2B)) ; points not shared
  (if (equal Pt1B Pt2A 0.0001)(setq PtC Pt2B))
  (if (equal Pt1A Pt2B 0.0001)(setq PtC Pt2A))
  (if (equal Pt1B Pt2B 0.0001)(setq PtC Pt2A))
  (setq MyInt (car (LM:3pcircle Pt1A Pt1B PtC)) )      ;;Intersection
  (setq MyRadius (cadr (LM:3pcircle Pt1A Pt1B PtC)) )  ;;Radius
  MyInt
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun trythis ( MyEnt AssessedLines ConnectedLines Int1 / p1 p2 TempLines acount AssessedLines Int1 Int2 ConnectedLines TryThisResult result)
  (setq p1 (cdr (assoc 10 (entget MyEnt))))
  (setq p2 (cdr (assoc 11 (entget MyEnt))))
  (if (= (linelength MyEnt 0.0001) 0)
    (princ " Short Line. ")
    (progn
  (repeat 2
    (setq TempLines (AdjLines MyEnt)) ; returns up to 2 entities
    ;; Remove from list duplicated in AssessedLines
    (setq acount (sslength TempLines))
    (while (> acount 0)
      (if (= (ssmemb (ssname TempLines (- acount 1) ) AssessedLines) nil)
        (progn
        )
        (progn
          (setq TempLines (ssdel (ssmemb (ssname TempLines (- acount 1)) AssessedLines) TempLines))
        ); end progn
      )  ; end if
      (setq acount (- acount 1))
    ) ; end while
    (if (= (sslength TempLines) 0)
      (progn ; temp lines all assessed.
      )
      (progn
        (setq AssessedLines (ssadd (ssname TempLines 0) AssessedLines)) ; add to assessed lines
        (if (= Int1 nil)
          (setq Int1 (Int MyEnt (ssname TempLines 0)))
        )
        (setq Int2 (Int MyEnt (ssname TempLines 0)))
        (if (< (distance Int1 Int2) 1)
        (progn
          (setq ConnectedLines (ssadd (ssname TempLines 0) ConnectedLines)) ; add to Connected lines
          (setq TryThisResult (trythis (ssname TempLines 0) AssessedLines ConnectedLines Int1))
          (setq AssessedLines  (car   TryThisResult))
          (setq ConnectedLines (cadr  TryThisResult))
          (setq Int1           (caddr TryThisResult))
        ) ; end progn
      )
      ) ; End progn
    )   ; end if
  ) ; end repeat 2
    ) ; end progn
  ) ; end if short MyEnt
  (setq result (list AssessedLines ConnectedLines Int1))
  result
) ; end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:Lines2Arc ( / ArcSS ArcLines ArcSSCount thisdrawing AnEnt AssessedLines Int1 ConnectedLines TryThisResult MyList P1 p1 p2 p3 counter acount)
  (setq ArcSS (ssget '((0 . "LINE"))))    ; Selection Set
  (setq ArcLines (ssadd))                 ; Selection Set for lines contained in an arc
  (setq ArcSSCount 0)                     ; A counter
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark thisdrawing)         ; Start Undo
  (while (< ArcSSCount (sslength ArcSS))  ; while loop
    (setq AnEnt (ssname ArcSS ArcSSCount)); Next entity in loop
    (if (= AssessedLines nil)(setq AssessedLines (ssadd))) ; create selection set
    (if (= (linelength AnEnt 0.0001) 0)   ; If the line is very short, ignore, move on
      (progn
      )
      (progn
;;Reset for next entity
        (setq Int1 nil)
        (setq ConnectedLines nil) (setq ConnectedLines (ssadd AnEnt))  ; List for connected lines
        (if (or
            (ssmemb AnEnt ArcLines)           ; If entity is in an arc....
            (ssmemb AnEnt AssessedLines)
          ) ; Endor
          (progn                              ; do nothing
          )
          (progn
            (setq TryThisResult (trythis AnEnt AssessedLines ConnectedLines Int1))
            (setq ConnectedLines (cadr TryThisResult))
            (setq Int1 (caddr TryThisResult))
            (if (or
                  (= ConnectedLines nil)
                  (> 4 (sslength ConnectedLines))       ; If more than 3 entities its an arc.
              ) ; end or
              (progn ; not an arc
              )
             (progn
                (setq MyList (uniquepoints ConnectedLines)) ; car: unique points, cadr: points list
                (setq ArcLines (LM:ss-union (list ArcLines ConnectedLines))) ; add entities to ignore list
                (if (= (car MyList) nil)
                  (progn
                    (princ "Full Circle")
                    (setq P1 (car (cadr MyList)) )
                    (command "circle" Int1 P1)
                  ) ; end progn
                  (progn
                    (setq p1 (car (car MyList)))  ; first unique point
                    (setq p2 (nth (/ (length (cadr MyList)) 2) (cadr MyList))) ; point within the arc
                    (setq p3 (cadr (car MyList))) ; second unique point
(setq counter 0)
(while (< counter (sslength ConnectedLines))
  (redraw (ssname ConnectedLines counter) 3)
  (setq counter (+ counter 1))
)
(command "delay" 50)
(setq counter 0)
(while (< counter (sslength ConnectedLines))
  (redraw (ssname ConnectedLines counter) 4)
  (setq counter (+ counter 1))
)
                    (3parc p1 p2 p3)              ; draw arc
                  ) ; end progn
                )   ; end if full circle
              ) ; end progn
            )   ; end if arc returned
          ) ; end progn
        )   ; end if entity in an arc
      ) ;; end progn
    ) ; end while short line
    (setq AssessedLines (ssadd AnEnt AssessedLines)) ; List of all lines assessed
    (setq ArcSSCount (+ ArcSSCount 1) )   ; Increase count
  ) ; end while
  (setq acount 0)
  (repeat (sslength ArcLines) ; delete arc lines. Use entdel to keep command line quiet
    (entdel (ssname ArcLines acount))
    (setq acount (+ acount 1))
  )
  (vla-endundomark thisdrawing)      ; end undo
  (princ)
)