(vl-load-com) ; Načtení rozšířených COM funkcí (nutné pro práci s Windows systémem)

(defun s:rt (v) (if (numberp v) (rtos v 2 8) ""))
(defun s:lineXY (p) (strcat (s:rt (car p)) "\t" (s:rt (cadr p))))

(defun s:getLWVertices (edata / verts)
  (setq verts '())
  (foreach x edata (if (= (car x) 10) (setq verts (cons (cdr x) verts))))
  (reverse verts))

(defun s:getPlineVerticesEntNext (e / verts ed)
  (setq verts '())
  (setq e (entnext e))
  (while e
    (setq ed (entget e))
    (cond
      ((= (cdr (assoc 0 ed)) "VERTEX") (setq verts (cons (cdr (assoc 10 ed)) verts)))
      ((= (cdr (assoc 0 ed)) "SEQEND") (setq e nil))
    )
    (if e (setq e (entnext e)))
  )
  (reverse verts))

;; Funkce pro vytažení bodů ze Spline
(defun s:getSplinePoints (ed / pts code)
  (setq pts '())
  (setq code (if (assoc 11 ed) 11 10))
  (foreach x ed
    (if (= (car x) code)
      (setq pts (cons (cdr x) pts))
    )
  )
  (reverse pts)
)

(defun s:getPoints (ent / ed typ)
  (setq ed (entget ent))
  (setq typ (cdr (assoc 0 ed)))
  (cond
    ((= typ "LWPOLYLINE") (s:getLWVertices ed))
    ((= typ "POLYLINE")   (s:getPlineVerticesEntNext ent))
    ((= typ "LINE")       (list (cdr (assoc 10 ed)) (cdr (assoc 11 ed))))
    ((= typ "SPLINE")     (s:getSplinePoints ed))
    (T nil)))

;; NOVÉ: Funkce pro skryté zkopírování textu do systémové schránky Windows
(defun s:CopyToClipboard (txt / WshShell fn f)
  ;; Vytvoří dočasný textový soubor v Temp složce Windows
  (setq fn (vl-filename-mktemp "clip.txt"))
  (setq f (open fn "w"))
  (princ txt f)
  (close f)
  
  ;; Použije WScript.Shell pro neviditelné spuštění příkazového řádku (0)
  (setq WshShell (vlax-create-object "WScript.Shell"))
  ;; Příkaz 'clip' přesměruje obsah souboru do schránky. 
  ;; Parametr :vlax-true zajistí, že AutoLISP počká, dokud proces neskončí
  (vlax-invoke WshShell 'Run (strcat "cmd.exe /c clip < \"" fn "\"") 0 :vlax-true)
  (vlax-release-object WshShell)
  
  ;; Uklizení - smazání dočasného souboru
  (vl-file-delete fn)
)

(defun c:SOURADNICE (/ ss i ent pts p isFirst outStr totalPts)
  (prompt "\nVyberte objekty (čára/polyčára/3D křivka/spline): ")
  
  (setq ss (ssget '((0 . "LINE,LWPOLYLINE,POLYLINE,SPLINE"))))
  
  (if (not ss)
    (prompt "\nNic nebylo vybráno.")
    (progn
      (setq i 0)
      (setq isFirst T)
      (setq outStr "")      ; Do této proměnné posbíráme veškerý text
      (setq totalPts 0)     ; Počitadlo bodů pro uživatele
      
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (setq pts (s:getPoints ent))
        
        (if (and pts (> (length pts) 0))
          (progn
            ;; Vložíme prázdný řádek mezi objekty
            (if (not isFirst)
              (setq outStr (strcat outStr "\n")) 
            )
            (setq isFirst nil)
            
            ;; Postupně text "slepujeme" (strcat) k sobě do proměnné outStr
            (foreach p pts
              (setq outStr (strcat outStr (s:lineXY p) "\n"))
              (setq totalPts (1+ totalPts))
            )
          )
        )
        (setq i (1+ i))
      )

      ;; Kopírování do schránky, pokud bylo co kopírovat
      (if (> (strlen outStr) 0)
        (progn
          (s:CopyToClipboard outStr)
          (prompt (strcat "\n*** Hotovo! " (itoa totalPts) " bodů bylo zkopírováno do schránky. Nyní můžete použít Ctrl+V ***"))
        )
        (prompt "\nNebyly nalezeny žádné platné body ke zkopírování.")
      )
    )
  )
  (princ)
)

(princ "\nNačteno. Příkaz: SOURADNICE (kopíruje rovnou do schránky!)")
(princ)