;;; - ------------------------------------------------------------------------------ - ;
;;; -                T O O L - A C M - P L 2 C I R C L E                             - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung : Umwandeln von kreis- und kreisbogenförmige Polylinien           - ;
;;; -                in Kreise und Kreisbögen mit Toleranzberücksichtigung           - ;
;;; - Befehle      : PL2CIRCLE                                                       - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Plattform    : AutoCAD 2020 oder höher                                         - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 21.02.2026                                                - ;
;;; -              durch : Thomas Krüger   (tk@cad-od.de)                            - ;
;;; - ------------------------------------------------------------------------------ - ;
(vl-load-com)
;;; - ------------------------------------------------------------------------------ - ;
  (defun DT:UNDOEND()
    (while(= 8(logand 8 (getvar "undoctl")))
      (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
    )      
  )
  (defun DT:UNDOSTART()
    (DT:UNDOEND)
    (vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
  )
  (defun DT:ERROR (MSG)    
    (if(not(wcmatch(strcase MSG t) "*break,*cancel*,*exit*"))      
      (princ (strcat "\nFEHLER: " MSG))
    )
    (DT:UNDOEND)
    (DT:RESET)
    (princ)
  )
  (defun DT:INIT()  
    (DT:UNDOSTART)        
    (setq ERRORSAVE *error*  *error* DT:ERROR
          
    )
  )
  (defun DT:RESET()
    (setq *error* ERRORSAVE)
    (mapcar '(lambda(X) (set X nil))(list 'ERRORSAVE))
    (DT:UNDOEND)
    (princ)
  )
;;; - ------------------------------------------------------------------------------ - ;

(defun PLS2CIRCLE ( OBJLIST DELETE? FUZZY
                  / RETVAL RETLIST ARCLIST OBJTYPE OBJEKT
                    IS-POINT? GET-M3P  VECTOR-GET-ANG INNENWINKELSUMME
                    DT:PL->CIRCLE
                  )
  (defun IS-POINT? (PKT)    
    (if(and(=(type PKT)'LIST)(vl-every 'numberp PKT))       
      (cond
        ((= 2 (vl-list-length PKT)) (list(car PKT)(cadr PKT) 0.0))
        ((= 3 (vl-list-length PKT)) PKT)
      )
    )  
  )  
  (defun GET-M3P(P1 P2 P3)
    (if(and(setq P1 (IS-POINT? P1))
           (setq P2 (IS-POINT? P2))
           (setq P3 (IS-POINT? P3))
           (setq M (apply 'inters
                     (append
                       (apply'append
                         (mapcar
                           '(lambda(A B / TMP)
                              (list
                                (setq TMP
                                      (mapcar
                                        '(lambda(C)(/ C 2.0))
                                         (mapcar'+ A B)
                                      )
                                )
                                (polar TMP(+(angle A B)(/ pi 2))1)
                              )
                            )
                            (list P1 P2)
                            (list P2 P3)
                         )
                       )
                       (list nil)
                     )
              )
           )
       )
      M
    )  
  )       
  (defun VECTOR-GET-ANG(VECTOR1 VECTOR2 / SKALAR B1 B2 COSINUS WINKEL)
    (if(and(setq VEKTOR1(IS-POINT? VECTOR1))
           (setq VEKTOR2(IS-POINT? VECTOR2))
           (setq SKALAR (apply '+ (mapcar '* VEKTOR1 VEKTOR2)))
           (/=(setq B1 (distance '(0.0 0.0 0.0) VECTOR1))0)
           (/=(setq B2 (distance '(0.0 0.0 0.0) VECTOR2))0)
           (setq COSINUS(/ SKALAR (float B1)(float B2)))
       )
      (progn
        (cond
          ((equal COSINUS 0 1e-300) (/ PI 2))
          ((>=  1 COSINUS 0)
            (setq WINKEL (atan(/(sqrt(- 1.0 (* COSINUS COSINUS)))COSINUS)))
          ) 
          ((<= -1 COSINUS 0)
            (+ PI (setq WINKEL (atan(/(sqrt(- 1.0 (* COSINUS COSINUS)))COSINUS))))
          )
        )
        (if (< SKALAR 0)
          (setq WINKEL (- PI WINKEL))
          WINKEL
        )  
      )
    )  
  )
  (defun INNENWINKELSUMME(PLIST M / WSUM)
    (setq WSUM 0)
    (if(and(=(type PLIST)'LIST)
           (setq M (IS-POINT? M))
       )    
      (while(and (setq P1 (IS-POINT?(car  PLIST)))
                 (setq P2 (IS-POINT?(cadr PLIST)))
                 (setq W (VECTOR-GET-ANG (mapcar '- P1 M)(mapcar '- P2 M)))
            )
        (setq WSUM(+ WSUM W))          
        (setq PLIST(cdr PLIST))    
      )
    )  
    WSUM  
  )  
  (defun PL2CIRCLE( OBJEKT DELETE? FUZZY
                  / VOBJEKT DATEN L P M R PB P1 P2 P3 RETVAL
                  )
    (if(and(=(type OBJEKT)'ENAME)
           (setq DATEN (entget OBJEKT))
           (member (strcase(cdr(assoc 0 DATEN)))'("LWPOLYLINE" "POLYLINE"))
           (setq VOBJEKT (vlax-ename->vla-object OBJEKT))      
           (not(vl-catch-all-error-p
                 (setq L (vl-catch-all-apply
                           'vlax-curve-getDISTAtPARAM
                            (list
                              VOBJEKT
                              (vlax-curve-getEndParam VOBJEKT)
                            )
                         )
                 )      
               )
           )
           (setq P (mapcar
                     '(lambda(X)
                        (vlax-curve-getPointAtDist
                          VOBJEKT
                          (* X L)
                        )
                      )
                     '(1.000 0.980  0.960 0.940 0.930 0.920 0.910
                       0.900 0.880  0.860 0.840 0.830 0.820 0.810
                       0.800 0.780  0.760 0.740 0.730 0.720 0.710
                       0.700 0.680  0.660 0.640 0.630 0.620 0.610
                       0.600 0.580  0.560 0.540 0.530 0.520 0.510
                       0.500 0.480  0.460 0.440 0.430 0.420 0.410
                       0.400 0.380  0.360 0.340 0.330 0.320 0.310
                       0.300 0.280  0.260 0.240 0.230 0.220 0.210
                       0.200 0.180  0.160 0.140 0.130 0.120 0.110
                       0.100 0.080  0.060 0.040 0.030 0.020 0.010
                       0.000
                      )
                   )
           )
           (setq M (list
                      (/(apply '+ (mapcar 'car   (cdr P)))(length (cdr P)) 1.0)
                      (/(apply '+ (mapcar 'cadr  (cdr P)))(length (cdr P)) 1.0)
                      (/(apply '+ (mapcar 'caddr (cdr P)))(length (cdr P)) 1.0)
                   )
           )
       )
      (progn
        (if(or(vlax-curve-isclosed VOBJEKT)                     ;_Kreis oder Kreisbogen ?
              (>(INNENWINKELSUMME P M)(* 0.998 2 PI))             
           )   
          (progn
            (setq R (/(apply '+ (mapcar'(lambda(X)(distance X M))P)  )
                      (length P)
                       1.0
                    )  
            )
            
            (if(and(not(vl-remove-if
                        '(lambda(Y)Y)
                           (mapcar'(lambda(X)(equal(distance M X) R (* FUZZY R)))P)
                         )
                   )
                   (entmake
                     (vl-remove-if '(lambda(X) (not(cdr X)))
                       (list
                         (cons   0                  "CIRCLE"  )
                         (cons 100              "AcDbEntity"  )
                         (cons  67    (cdr(assoc  67 DATEN))  )
                         (cons 410    (cdr(assoc 410 DATEN))  )
                         (cons   8    (cdr(assoc   8 DATEN))  )
                         (cons  62    (cdr(assoc  62 DATEN))  )
                         (cons 420    (cdr(assoc 420 DATEN))  )
                         (cons 430    (cdr(assoc 430 DATEN))  )
                         (cons   6    (cdr(assoc   6 DATEN))  )
                         (cons 370    (cdr(assoc 370 DATEN))  )
                         (cons 100              "AcDbCircle"  )
                         (cons  10                        M   )
                         (cons  40                        R   )
                         (cons 210    (cdr(assoc 210 DATEN))  )
                       )
                     )
                   )
               )     
              (setq RETVAL(entlast))
            )
          )
          
          (if(and(setq PB (mapcar
                            '(lambda(x)
                               (vlax-curve-getPointAtDist
                                 VOBJEKT
                                 (* X L)
                               )
                             )
                            '(1.000 0.750  0.500 0.250 0.000)
                          )
                 )           
                 (setq P1(GET-M3P (nth 0 PB) (nth 1 PB)(nth 2 PB)))
                 (setq P2(GET-M3P (nth 1 PB) (nth 2 PB)(nth 3 PB)))
                 (setq P3(GET-M3P (nth 2 PB) (nth 3 PB)(nth 4 PB)))                             
                 (setq M (list 
                            (/(apply '+ (mapcar 'car   (list P1 P2 P3)))3.0)
                            (/(apply '+ (mapcar 'cadr  (list P1 P2 P3)))3.0)
                            (/(apply '+ (mapcar 'caddr (list P1 P2 P3)))3.0)
                         )
                 )           
                 (setq R (/(apply '+ (mapcar
                                       '(lambda(X)(distance X M))
                                       (cdr(reverse(cdr P)))
                                     )  
                           )
                           (-(length P)2)
                           1.0
                         )
                 )
                 (not(vl-remove-if 
                       '(lambda(Y)Y)
                        (mapcar'(lambda(X)(equal(distance M X) R (* FUZZY R)))P)
                     )
                 )                                                                           
                 (or(and(setq W1(angle M (vlax-curve-getSTARTPoint  VOBJEKT)))
                        (<= W1 PI)
                    )
                    (setq W1(- W1 (* 2.0 Pi)))
                 )
                 (or(and(setq W2(angle M (vlax-curve-getENDPoint  VOBJEKT)))
                        (<= W2 PI)
                    )
                    (setq W2(- W2 (* 2.0 Pi)))
                 )
                 (or(and(setq W3(angle M (vlax-curve-getPointAtDist VOBJEKT (* L 0.5))))
                        (<= W3 PI)
                    )
                    (setq W3(- W3 (* 2.0 Pi)))
                 ) 
                 (if (equal(/(+ W1 W2)2) W3 0.1)          
                   (progn (setq GC50 (min W1 W2))(setq GC51 (max W1 W2)))             
                   (progn (setq GC50 (max W1 W2))(setq GC51 (min W1 W2)))
                 )
                 (entmake
                   (vl-remove-if '(lambda(X) (not(cdr X)))
                     (list
                       (cons   0                     "ARC"  )
                       (cons 100              "AcDbEntity"  )
                       (cons  67    (cdr(assoc  67 DATEN))  )
                       (cons 410    (cdr(assoc 410 DATEN))  )
                       (cons   8    (cdr(assoc   8 DATEN))  )
                       (cons  62    (cdr(assoc  62 DATEN))  )
                       (cons 420    (cdr(assoc 420 DATEN))  )
                       (cons 430    (cdr(assoc 430 DATEN))  )
                       (cons   6    (cdr(assoc   6 DATEN))  )
                       (cons 370    (cdr(assoc 370 DATEN))  )
                       (cons 100              "AcDbCircle"  )
                       (cons  10                        M   )
                       (cons  40                        R   )
                       (cons 210    (cdr(assoc 210 DATEN))  )
                       (cons 100                 "AcDbArc"  )
                       (cons  50                     GC50   )
                       (cons  51                     GC51   )
                     )
                   )
                 )
             )
            (setq RETVAL(entlast))
          )           
        )      
        (if RETVAL
          (progn
            (if DELETE?
              (vl-catch-all-error-p(vl-catch-all-apply'vla-Delete (list  VOBJEKT)))  
            )
            RETVAL
          )
        )   
      )
    )   
  )             
  ;_ Hauptfunktion ----------------------------------------------------------------- - ;
  (if(and(or FUZZY(setq FUZZY 0.05))
         (=(type OBJLIST)'LIST)                
         (setq OBJLIST
           (vl-remove-if-not
              '(lambda(X)(and(=(type X)'ENAME)
                               (member(strcase(cdr(assoc 0 (entget X))))
                                      '("LWPOLYLINE" "POLYLINE")
                               )       
                         )    
               )
               OBJLIST
           )
         )
     )
    (progn
      (foreach OBJEKT OBJLIST
        (setq OBJTYPE(strcase(cdr(assoc 0 (entget OBJEKT)))))
        (cond
          ((member OBJTYPE '("LWPOLYLINE" "POLYLINE"))                           
            (if (setq RETVAL(PL2CIRCLE OBJEKT DELETE? FUZZY))
              (setq RETLIST(cons RETVAL RETLIST))              
            )
          )          
        )
      )          
    )
  )  
  RETLIST
)        
;;; - ------------------------------------------------------------------------------ - ;
(defun C:PL2CIRCLE (/ AUSWAHL INDEX OBJLIST FUZZY DELETE? RETLIST)
  (if(and(or(setq AUSWAHL (ssget "I"   '((0 . "*POLYLINE"))))
            (setq AUSWAHL (ssget       '((0 . "*POLYLINE"))))
            (prompt "\nKeine Polylinien ausgewählt.Abbruch.\n")
         )
         (or (initget (+ 2 4))'T)
         (or (setq FUZZY(getreal "\nRelative Toleranz:<0.05> "))
             (setq FUZZY 0.05)
         )         
     ) 
    (progn      
      (initget "Ja Nein")
      (setq DELETE?
        (/=(getkword"\nUrsprungsobjekte löschen [Ja / Nein] : <Ja>? ")"Nein")
      )
      (DT:INIT)
      (setq INDEX -1)
      (repeat(sslength AUSWAHL)
        (setq OBJLIST (cons (ssname AUSWAHL(setq INDEX (1+ INDEX))) OBJLIST))
      )
      (setq RETLIST(PLS2CIRCLE OBJLIST DELETE? FUZZY))      
      (DT:RESET)
    )  
  )  
  (princ)
)
;;; - ------------------------------------------------------------------------------ - ;
(defun ACM-PL2CIRCLE:INFO() 
  (mapcar
    'princ
    (list
      "\n\n"
      "\nACM-PL2CIRCLE : Umwandeln von kreis- und kreisbogenförmige Polylinien"
      "\n==============  in Kreise und Kreisbögen mit Toleranzberücksichtigung"    
      "\n(C) Thomas Krüger 2026" 
      "\nE-Mail: tk@cad-od.de"
      "\nBefehlszeilenaufruf : PL2CIRCLE\n"   
    )
  )
  (princ)  
)
;;; - ------------------------------------------------------------------------------- - ;
(ACM-PL2CIRCLE:INFO)
(princ)

