;;; ==========================================================================
;;; PAKIRP.lsp  -  Parsel Atlasi "Pafta Kirp" komutu (ucretsiz)
;;; Surum 1.0 - 14.11.2026 - parselatlasi.com/cbs/pafta-kirp/
;;;
;;; Kullanim : APPLOAD ile yukleyin, komut satirina PAKIRP yazin.
;;;   1) Kapali bir sinir secin: daire, dikdortgen, kapali cizgi
;;;      (LWPOLYLINE), kapali POLYLINE / SPLINE / ELIPS.
;;;   2) Sinirin icinde kalan ve siniri kesen nesnelerin KESILMIS
;;;      KOPYASI uretilir. Orijinal cizim degismez.
;;;   3) Kopyayi tasimak icin temel nokta ve yeni konum gosterin;
;;;      ENTER ile kopya yerinde kalir (koordinatlar korunur).
;;;
;;; Kesilen nesneler : LINE, LWPOLYLINE (yayli parcalar kucuk dogru
;;;                    parcalarina bolunur), ARC, CIRCLE.
;;; Aynen kopyalanan : yerlesim noktasi icerdeki TEXT, MTEXT, INSERT,
;;;                    POINT; tamamen icerdeki tum nesneler.
;;; Kesilmeyenler    : siniri kesen HATCH, SPLINE, ELLIPSE, 3B POLYLINE,
;;;                    REGION vb. Sayilari komut sonunda yazilir; bunlar
;;;                    icin web araci: parselatlasi.com/cbs/pafta-kirp/
;;; Express Tools GEREKMEZ. Yalnizca model/kagit alaninda gorunen
;;; nesneler secilir (AutoCAD CP secim kurali).
;;; Bilgi amaclidir; resmi olcu veya aplikasyon yerine gecmez.
;;; parselatlasi.com | plotdossier.com | turkeypropertycheck.com
;;; ==========================================================================

(vl-load-com)

;;; ---------- kucuk yardimcilar ----------
(defun pk:z (p) (if (caddr p) (caddr p) 0.0))

(defun pk:lerp (a b tt)
  (list (+ (car a) (* tt (- (car b) (car a))))
        (+ (cadr a) (* tt (- (cadr b) (cadr a))))
        (+ (pk:z a) (* tt (- (pk:z b) (pk:z a))))))

(defun pk:2b (p) (list (car p) (cadr p)))

;;; Nokta-cokgen icinde mi (isin atma). poly: kapanmayan nokta listesi
(defun pk:pip (p poly / px py prev ic)
  (setq px (car p) py (cadr p) prev (last poly) ic nil)
  (foreach q poly
    (if (and (not (eq (> (cadr q) py) (> (cadr prev) py)))
             (< px (+ (car q)
                      (/ (* (- (car prev) (car q)) (- py (cadr q)))
                         (- (cadr prev) (cadr q))))))
      (setq ic (not ic)))
    (setq prev q))
  ic)

;;; Sinir kutusu (xmin ymin xmax ymax)
(defun pk:kutu (pts / x0 y0 x1 y1)
  (setq x0 (car (car pts)) y0 (cadr (car pts)) x1 x0 y1 y0)
  (foreach p pts
    (setq x0 (min x0 (car p)) y0 (min y0 (cadr p))
          x1 (max x1 (car p)) y1 (max y1 (cadr p))))
  (list x0 y0 x1 y1))

;;; Sinir yapisi: (list "P" noktalar nil kutu)  veya  (list "C" merkez yaricap kutu)
(defun pk:sinir-p (pts)
  (if (equal (pk:2b (car pts)) (pk:2b (last pts)) 1e-9)
    (setq pts (reverse (cdr (reverse pts)))))
  (list "P" (mapcar 'pk:2b pts) nil (pk:kutu pts)))

(defun pk:sinir-c (c r)
  (list "C" (pk:2b c) r
        (list (- (car c) r) (- (cadr c) r) (+ (car c) r) (+ (cadr c) r))))

(defun pk:ic (p sn)
  (if (= (car sn) "C")
    (< (distance (pk:2b p) (cadr sn)) (caddr sn))
    (pk:pip p (cadr sn))))

;;; ab dogru parcasi ile cd kenari kesisiyorsa ab uzerindeki parametre
(defun pk:seg-t (a b c d / dx dy ex ey den tt u)
  (setq dx (- (car b) (car a)) dy (- (cadr b) (cadr a))
        ex (- (car d) (car c)) ey (- (cadr d) (cadr c))
        den (- (* dx ey) (* dy ex)))
  (if (> (abs den) 1e-12)
    (progn
      (setq tt (/ (- (* (- (car c) (car a)) ey) (* (- (cadr c) (cadr a)) ex)) den)
            u  (/ (- (* (- (car c) (car a)) dy) (* (- (cadr c) (cadr a)) dx)) den))
      (if (and (>= tt -1e-12) (<= tt (+ 1.0 1e-12))
               (>= u -1e-12) (<= u (+ 1.0 1e-12)))
        tt))))

;;; ab dogrusu ile (c,r) dairesinin kesisim parametreleri [0,1]
(defun pk:seg-cember (a b c r / dx dy fx fy qa qb qc disc s res)
  (setq dx (- (car b) (car a)) dy (- (cadr b) (cadr a))
        fx (- (car a) (car c)) fy (- (cadr a) (cadr c))
        qa (+ (* dx dx) (* dy dy))
        qb (* 2.0 (+ (* fx dx) (* fy dy)))
        qc (- (+ (* fx fx) (* fy fy)) (* r r))
        disc (- (* qb qb) (* 4.0 qa qc))
        res nil)
  (if (and (> qa 1e-18) (>= disc 0.0))
    (progn
      (setq s (sqrt disc))
      (foreach tt (list (/ (- (- qb) s) (* 2.0 qa)) (/ (+ (- qb) s) (* 2.0 qa)))
        (if (and (>= tt -1e-12) (<= tt (+ 1.0 1e-12)))
          (setq res (cons tt res))))))
  res)

;;; ab parcasinin sinirla kesisim parametreleri
(defun pk:seg-ts (a b sn / prev res tt)
  (if (= (car sn) "C")
    (pk:seg-cember a b (cadr sn) (caddr sn))
    (progn
      (setq prev (last (cadr sn)) res nil)
      (foreach q (cadr sn)
        (if (setq tt (pk:seg-t a b prev q)) (setq res (cons tt res)))
        (setq prev q))
      res)))

;;; parca kutusu sinir kutusunun tamamen disinda mi
(defun pk:kutu-dis (a b K)
  (or (< (max (car a) (car b)) (nth 0 K)) (> (min (car a) (car b)) (nth 2 K))
      (< (max (cadr a) (cadr b)) (nth 1 K)) (> (min (cadr a) (cadr b)) (nth 3 K))))

;;; ab parcasini keser: icerde kalan (p q) parcalarinin listesi
(defun pk:kes-seg (a b sn / ts res t0 t1)
  (if (pk:kutu-dis a b (cadddr sn))
    nil
    (progn
      (setq ts (vl-sort
                 (append (list 0.0 1.0)
                         (vl-remove-if '(lambda (x) (or (<= x 1e-12) (>= x (- 1.0 1e-12))))
                                       (pk:seg-ts a b sn)))
                 '<)
            res nil)
      (while (cdr ts)
        (setq t0 (car ts) t1 (cadr ts))
        (if (and (> (- t1 t0) 1e-9)
                 (pk:ic (pk:lerp a b (/ (+ t0 t1) 2.0)) sn))
          (if (and res (equal (cadr (car res)) t0 1e-12))
            (setq res (cons (list (car (car res)) t1) (cdr res)))
            (setq res (cons (list t0 t1) res))))
        (setq ts (cdr ts)))
      (mapcar '(lambda (pr) (list (pk:lerp a b (car pr)) (pk:lerp a b (cadr pr))))
              (reverse res)))))

;;; Cizgi zinciri durumu: "IC" tamamen icerde, "DIS" tamamen disarida, "KES" kesiyor
(defun pk:durum (pts sn / a kes)
  (setq a (car pts) kes nil)
  (foreach b (cdr pts)
    (if (and (not kes) (not (pk:kutu-dis a b (cadddr sn))))
      (if (vl-remove-if '(lambda (x) (or (<= x 1e-9) (>= x (- 1.0 1e-9)))) (pk:seg-ts a b sn))
        (setq kes T)))
    (setq a b))
  (cond (kes "KES")
        ((pk:ic (pk:lerp (car pts) (cadr pts) 0.5) sn) "IC")
        (T "DIS")))

;;; Nokta listesini (zincir) keser; parca zincirlerinin listesi
(defun pk:kes-zincir (pts kapali sn / out cur a)
  (setq out nil cur nil a (car pts))
  (foreach b (cdr pts)
    (foreach pc (pk:kes-seg a b sn)
      (if (and cur (equal (pk:2b (car pc)) (pk:2b (car cur)) 1e-9))
        (setq cur (cons (cadr pc) cur))
        (progn
          (if cur (setq out (cons (reverse cur) out)))
          (setq cur (list (cadr pc) (car pc))))))
    (setq a b))
  (if cur (setq out (cons (reverse cur) out)))
  (setq out (reverse out))
  ;; kapali zincirde son parca ilk parcaya baglaniyorsa birlestir
  (if (and kapali (cdr out)
           (equal (pk:2b (last (last out))) (pk:2b (car (car out))) 1e-9))
    (setq out (cons (append (last out) (cdr (car out)))
                    (reverse (cdr (reverse (cdr out)))))))
  out)

;;; Aci normalizasyonu: a0 <= x < a0 + 2pi
(defun pk:aci-norm (x a0)
  (while (< x a0) (setq x (+ x (* 2.0 pi))))
  (while (>= x (+ a0 (* 2.0 pi))) (setq x (- x (* 2.0 pi))))
  x)

;;; iki dairenin kesisim noktalari
(defun pk:cember-cember (c1 r1 c2 r2 / d a h m dx dy)
  (setq d (distance (pk:2b c1) (pk:2b c2)))
  (if (or (< d 1e-12) (> d (+ r1 r2)) (< d (abs (- r1 r2))))
    nil
    (progn
      (setq a (/ (+ (- (* r1 r1) (* r2 r2)) (* d d)) (* 2.0 d))
            h (sqrt (max 0.0 (- (* r1 r1) (* a a))))
            dx (/ (- (car c2) (car c1)) d) dy (/ (- (cadr c2) (cadr c1)) d)
            m (list (+ (car c1) (* a dx)) (+ (cadr c1) (* a dy))))
      (list (list (- (car m) (* h dy)) (+ (cadr m) (* h dx)))
            (list (+ (car m) (* h dy)) (- (cadr m) (* h dx)))))))

;;; Yay/daire kesimi: (c r a0 a1) -> icerdeki (bas son) aci ciftleri
(defun pk:kes-yay (c r a0 a1 sn / noktalar prev acilar ts res s0 s1 orta)
  (setq noktalar nil)
  (if (= (car sn) "C")
    (setq noktalar (pk:cember-cember c r (cadr sn) (caddr sn)))
    (progn
      (setq prev (last (cadr sn)))
      (foreach q (cadr sn)
        (foreach tt (pk:seg-cember prev q c r)
          (setq noktalar (cons (pk:lerp prev q tt) noktalar)))
        (setq prev q))))
  (setq acilar nil)
  (foreach p noktalar
    (setq s0 (pk:aci-norm (angle (pk:2b c) (pk:2b p)) a0))
    (if (and (> s0 (+ a0 1e-12)) (< s0 (- a1 1e-12)))
      (setq acilar (cons s0 acilar))))
  (setq ts (vl-sort (append (list a0 a1) acilar) '<) res nil)
  (while (cdr ts)
    (setq s0 (car ts) s1 (cadr ts) orta (/ (+ s0 s1) 2.0))
    (if (and (> (- s1 s0) 1e-10) (pk:ic (polar (pk:2b c) orta r) sn))
      (if (and res (equal (cadr (car res)) s0 1e-12))
        (setq res (cons (list (car (car res)) s1) (cdr res)))
        (setq res (cons (list s0 s1) res))))
    (setq ts (cdr ts)))
  (setq res (reverse res))
  ;; tam dairede 0/2pi dikisini birlestir
  (if (and (equal (- a1 a0) (* 2.0 pi) 1e-9) (cdr res)
           (equal (car (car res)) a0 1e-12) (equal (cadr (last res)) a1 1e-12))
    (setq res (cons (list (- (car (last res)) (* 2.0 pi)) (cadr (car res)))
                    (reverse (cdr (reverse (cdr res)))))))
  res)

;;; Yayli (bulge) parcayi noktalara boler; p1 haric, p2 dahil
(defun pk:bulge-noktalar (p1 p2 b / c r sa sw n i out z)
  (if (< (abs b) 1e-12)
    (list p2)
    (progn
      (setq c  (polar (pk:2b p1) (+ (angle (pk:2b p1) (pk:2b p2)) (- (/ pi 2.0) (* 2.0 (atan b))))
                      (/ (* (distance (pk:2b p1) (pk:2b p2)) (+ 1.0 (* b b))) 4.0 b))
            r  (distance c (pk:2b p1))
            sa (angle c (pk:2b p1))
            sw (* 4.0 (atan b))
            n  (max 4 (fix (* 16.0 (/ (abs sw) pi))))
            i  1 out nil z (pk:z p1))
      (while (< i n)
        (setq out (cons (append (polar c (+ sa (* sw (/ (float i) n))) r) (list z)) out)
              i (1+ i)))
      (reverse (cons p2 out)))))

;;; LWPOLYLINE verisinden 3B nokta listesi (yaylar bolunmus) + kapali bayragi
(defun pk:lw-noktalar (ed / el pts blg kapali sonuc onc i)
  (setq el (if (assoc 38 ed) (cdr (assoc 38 ed)) 0.0)
        kapali (= 1 (logand 1 (cdr (assoc 70 ed))))
        pts nil blg nil)
  (foreach g ed
    (cond ((= (car g) 10) (setq pts (cons (list (cadr g) (caddr g) el) pts) blg (cons 0.0 blg)))
          ((= (car g) 42) (if blg (setq blg (cons (cdr g) (cdr blg)))))))
  (setq pts (reverse pts) blg (reverse blg))
  (if kapali (setq pts (append pts (list (car pts)))))
  (setq sonuc (list (car pts)) onc (car pts) i 0)
  (foreach p (cdr pts)
    (setq sonuc (append (reverse (pk:bulge-noktalar onc p (nth i blg))) sonuc)
          onc p i (1+ i)))
  (list (reverse sonuc) kapali))

;;; Egriden (vlax-curve) ornek noktalar
(defun pk:egri-noktalar (en n / o l i out)
  (setq o (vlax-ename->vla-object en)
        l (vlax-curve-getDistAtParam o (vlax-curve-getEndParam o))
        i 0 out nil)
  (while (<= i n)
    (setq out (cons (vlax-curve-getPointAtDist o (* l (/ (float i) n))) out) i (1+ i)))
  (reverse (vl-remove nil out)))

;;; ---------- entmake ----------
(defun pk:ozellik (ed)
  (vl-remove-if-not '(lambda (x) (member (car x) '(6 8 39 48 60 62 67 370 410 420 430 440))) ed))

(defun pk:yeni (lst / e)
  (if (entmake lst)
    (progn (setq e (entlast)) (ssadd e pk:*yeni*) e)))

(defun pk:kopya (en / o)
  (setq o (vla-copy (vlax-ename->vla-object en)))
  (ssadd (vlax-vla-object->ename o) pk:*yeni*))

(defun pk:lw-yaz (pts ed / w)
  (setq w (assoc 43 ed))
  (pk:yeni (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity"))
                   (pk:ozellik ed)
                   (list '(100 . "AcDbPolyline") (cons 90 (length pts)) '(70 . 0)
                         (cons 38 (pk:z (car pts))))
                   (if w (list w))
                   (mapcar '(lambda (p) (list 10 (car p) (cadr p))) pts))))

(defun pk:extr-ok (ed / x)
  (setq x (assoc 210 ed))
  (or (null x) (equal (cdr x) '(0.0 0.0 1.0) 1e-9)))

;;; kutu (vla bounding box) tamamen icerde mi
(defun pk:kutu-ic (en sn / o mn mx a b c d kose ok prev)
  (setq o (vlax-ename->vla-object en))
  (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'mn 'mx)))
    nil
    (progn
      (setq mn (vlax-safearray->list mn) mx (vlax-safearray->list mx)
            a (list (car mn) (cadr mn)) b (list (car mx) (cadr mn))
            c (list (car mx) (cadr mx)) d (list (car mn) (cadr mx))
            kose (list a b c d))
      (setq ok (and (pk:ic a sn) (pk:ic b sn) (pk:ic c sn) (pk:ic d sn)))
      (if (and ok (= (car sn) "P"))
        (progn
          (foreach q (cadr sn)
            (if (and (> (car q) (car a)) (< (car q) (car c)) (> (cadr q) (cadr a)) (< (cadr q) (cadr c)))
              (setq ok nil)))
          (setq prev d)
          (foreach k kose
            (if (and ok (pk:seg-ts prev k sn)) (setq ok nil))
            (setq prev k))))
      ok)))

;;; ---------- nesne isleyiciler ----------
(defun pk:say (k) (set k (1+ (eval k))))

(defun pk:isle (en sn / ed tip p q d pts kapali r a0 a1 c)
  (setq ed (entget en) tip (cdr (assoc 0 ed)))
  (cond
    ((= tip "LINE")
     (setq p (cdr (assoc 10 ed)) q (cdr (assoc 11 ed)) d (pk:durum (list p q) sn))
     (cond ((= d "IC") (pk:kopya en) (pk:say 'pk:*aynen*))
           ((= d "KES")
            (foreach pc (pk:kes-seg p q sn)
              (pk:yeni (append (list '(0 . "LINE")) (pk:ozellik ed)
                               (list (cons 10 (car pc)) (cons 11 (cadr pc))))))
            (pk:say 'pk:*kesilen*))))
    ((and (= tip "LWPOLYLINE") (pk:extr-ok ed))
     (setq pts (pk:lw-noktalar ed) kapali (cadr pts) pts (car pts))
     (if (cdr pts)
       (progn
         (setq d (pk:durum pts sn))
         (cond ((= d "IC") (pk:kopya en) (pk:say 'pk:*aynen*))
               ((= d "KES")
                (foreach z (pk:kes-zincir pts kapali sn)
                  (if (cdr z) (pk:lw-yaz z ed)))
                (pk:say 'pk:*kesilen*))))))
    ((and (member tip '("ARC" "CIRCLE")) (pk:extr-ok ed))
     (setq c (cdr (assoc 10 ed)) r (cdr (assoc 40 ed)))
     (if (= tip "CIRCLE")
       (setq a0 0.0 a1 (* 2.0 pi))
       (setq a0 (cdr (assoc 50 ed)) a1 (cdr (assoc 51 ed))
             a1 (if (<= a1 a0) (+ a1 (* 2.0 pi)) a1)))
     (setq d (pk:kes-yay c r a0 a1 sn))
     (cond ((null d))
           ((and (null (cdr d)) (equal (- (cadr (car d)) (car (car d))) (- a1 a0) 1e-9))
            (pk:kopya en) (pk:say 'pk:*aynen*))
           (T
            (foreach s d
              (pk:yeni (append (list '(0 . "ARC")) (pk:ozellik ed)
                               (list (cons 10 c) (cons 40 r)
                                     (cons 50 (pk:aci-norm (car s) 0.0))
                                     (cons 51 (pk:aci-norm (cadr s) 0.0))))))
            (pk:say 'pk:*kesilen*))))
    ((member tip '("TEXT" "MTEXT" "INSERT" "POINT" "ATTDEF" "DIMENSION"))
     (if (pk:ic (cdr (assoc 10 ed)) sn) (progn (pk:kopya en) (pk:say 'pk:*aynen*))))
    ((pk:kutu-ic en sn) (pk:kopya en) (pk:say 'pk:*aynen*))
    (T (pk:say 'pk:*atlanan*)
       (setq pk:*atlanan-tip* (if (member tip pk:*atlanan-tip*) pk:*atlanan-tip* (cons tip pk:*atlanan-tip*))))))

;;; ---------- komut ----------
(defun c:PAKIRP (/ *error* eski-cmd eski-os sec en ed tip sn pts cp ss i n bp dp k)
  (defun *error* (m)
    (if (and m (not (wcmatch (strcase m) "*CANCEL*,*QUIT*,*IPTAL*")))
      (princ (strcat "\nPAKIRP hata: " m)))
    (if eski-os (setvar "OSMODE" eski-os))
    (command-s "_.UNDO" "_END")
    (if eski-cmd (setvar "CMDECHO" eski-cmd))
    (princ))
  (setq eski-cmd (getvar "CMDECHO") eski-os (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
  (command "_.UNDO" "_BEGIN")
  (setq pk:*yeni* (ssadd) pk:*aynen* 0 pk:*kesilen* 0 pk:*atlanan* 0 pk:*atlanan-tip* nil)
  (while (not sn)
    (setq sec (entsel "\nKapali sinir secin (daire / dikdortgen / kapali cizgi): "))
    (cond
      ((null sec) (exit))
      (T
       (setq en (car sec) ed (entget en) tip (cdr (assoc 0 ed)))
       (cond
         ((and (= tip "CIRCLE") (pk:extr-ok ed))
          (setq sn (pk:sinir-c (cdr (assoc 10 ed)) (cdr (assoc 40 ed)))))
         ((and (= tip "LWPOLYLINE") (pk:extr-ok ed)
               (or (= 1 (logand 1 (cdr (assoc 70 ed))))
                   (equal (pk:2b (car (car (pk:lw-noktalar ed))))
                          (pk:2b (last (car (pk:lw-noktalar ed)))) 1e-9)))
          (setq sn (pk:sinir-p (car (pk:lw-noktalar ed)))))
         ((and (member tip '("POLYLINE" "SPLINE" "ELLIPSE"))
               (vlax-curve-isClosed (vlax-ename->vla-object en)))
          (setq sn (pk:sinir-p (pk:egri-noktalar en 720))))
         (T (princ "\nSecilen nesne kapali bir sinir degil. Tekrar deneyin."))))))
  (if (< (length (cadr sn)) 3) (progn (princ "\nSinir gecersiz.") (exit)))
  ;; secim cokgeni (dairede biraz genis 72-gen)
  (if (= (car sn) "C")
    (progn
      (setq cp nil i 0 k (/ (* 1.02 (caddr sn)) (cos (/ pi 72.0))))
      (while (< i 72) (setq cp (cons (polar (cadr sn) (* i (/ pi 36.0)) k) cp) i (1+ i))))
    (setq cp (cadr sn)))
  (setvar "OSMODE" 0)
  (setq k (cadddr sn))
  (command "_.ZOOM" "_W"
           (list (- (nth 0 k) (* 0.05 (- (nth 2 k) (nth 0 k)))) (- (nth 1 k) (* 0.05 (- (nth 3 k) (nth 1 k)))))
           (list (+ (nth 2 k) (* 0.05 (- (nth 2 k) (nth 0 k)))) (+ (nth 3 k) (* 0.05 (- (nth 3 k) (nth 1 k))))))
  (setq ss (ssget "_CP" cp))
  (command "_.ZOOM" "_P")
  (setvar "OSMODE" eski-os)
  (if ss (ssdel en ss))
  (if (or (null ss) (= 0 (sslength ss)))
    (princ "\nSinir icinde nesne bulunamadi.")
    (progn
      (setq i 0 n (sslength ss))
      (princ (strcat "\n" (itoa n) " nesne isleniyor..."))
      (while (< i n)
        (vl-catch-all-apply 'pk:isle (list (ssname ss i) sn))
        (setq i (1+ i)))
      (princ (strcat "\nPAKIRP: " (itoa pk:*aynen*) " nesne aynen kopyalandi, "
                     (itoa pk:*kesilen*) " nesne sinirdan kesildi"
                     (if (> pk:*atlanan* 0)
                       (strcat ", " (itoa pk:*atlanan*) " nesne kesilemedi ("
                               (apply 'strcat (mapcar '(lambda (x) (strcat x " ")) pk:*atlanan-tip*))
                               "- web araci: parselatlasi.com/cbs/pafta-kirp/)")
                       "")
                     "."))
      (if (> (sslength pk:*yeni*) 0)
        (progn
          (setq bp (getpoint "\nKopyanin temel noktasi <yerinde birak>: "))
          (if bp
            (progn
              (setq dp (getpoint bp "\nYeni konum: "))
              (if dp
                (progn
                  (setvar "OSMODE" 0)
                  (command "_.MOVE" pk:*yeni* "" bp dp)
                  (setvar "OSMODE" eski-os)))))
          (sssetfirst nil pk:*yeni*)))))
  (command "_.UNDO" "_END")
  (setvar "CMDECHO" eski-cmd)
  (princ))

(princ "\nPAKIRP yuklendi - Parsel Atlasi Pafta Kirp. Komut: PAKIRP")
(princ)