;Derya KILIÇ temmuz'2000 Oflaz İnşaat
;birinci yazının içeriğini ikinciye kopyalar

;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
;;;ENTSEC
;;;konu		: filtreli, tek obje seçme fonksiyonu
;;;amaç		: tip ile verilen obje tipini (örn: "LINE" "TEXT" vb.) tek tıklamayla seçtirmek,
;;;       	                   boş tıklamaları dikkate almamak ve sağ tuşla seçimden vazgeçilebilmesini sağlamak.
;;;not 		: tip parametresi nil verilmişse filtreleme uygulanmaz.
;;;kullanım 	: (entsec "LINE" "\nReferans çizgiyi seçiniz..")
;;;                               (entsec nil "\nLayer'i kapatılacak objeyi seçiniz.")
;;;dönüş değeri	: uygun obje seçilmişse <entity name> , sağ tuşla vazgeçilmişse nil.
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
(defun entsec (tip msj / __elist __ent __kont)
  (setvar "ERRNO" 0) (setq __kont t)
  (while (and __kont (/= 52 (getvar "ERRNO")))
    (setq __ent (car (entsel msj)))
    (if __ent
       (if tip
	 (if (= tip (cdr (assoc 0 (entget __ent))))
	     (setq __kont nil)
	     (princ (strcat "\n" (cdr (assoc 0 (entget __ent))) " seçemezsiniz. Lütfen bir " tip " seçiniz."))
	 )
         (setq __kont nil)
       )
    )
  ) ;_while
__ent
) ;_defun entsec
;;;****************************** ana program ********************
(defun c:tes(/ yazi elist ent)
   (if (null __oncekiyazi__) (setq __oncekiyazi__ ""))
   (setq ent (entsec "TEXT"  (strcat "\nKaynak Yazıyı Seç <" __oncekiyazi__ "> :")))
   (setq yazi (if ent (cdr (assoc 1 (entget ent))) __oncekiyazi__))
   (if (/= "" yazi) (progn
       (princ yazi)
       (setq __oncekiyazi__ yazi)
       (if (setq ent (entsec "TEXT" "\nHedef Yazıyı Seç :"))
	 (progn
            (setq elist (entget ent))
            (princ (cdr (assoc 1 elist)))
	    (setvar "CMDECHO" 0)
            (command "undo" "mark")
            (setq elist  (subst  (cons 1 yazi) (assoc 1 elist) elist))
            (entmod elist)
            (if (= 35 (getvar "ERRNO")) (princ "\nSeçtiğiniz yazı kilitli tabakada. Değiştirilemiyor."))
	    (command "undo" "end")
	    (setvar "CMDECHO" 1)
       ));_if-progn
   ))
 (princ)
);defun
(defun c:ty( / yuk elist ent ents)
  (if (null __oncekiyukseklik__) (setq __oncekiyukseklik__ 2.0))
  (setq yuk (getdist (strcat "\nYeni Yüksekliği Giriniz <" (rtos __oncekiyukseklik__ 2) ">:")))
  (if yuk (setq __oncekiyukseklik__ yuk) (setq yuk __oncekiyukseklik__))
  (setvar "CMDECHO" 0)
  (command "undo" "mark")
  (princ "\nYüksekliği değiştirilecek yazıları seçiniz :")
  (setq ents (ssget '((0 . "TEXT"))) i 0)
  (while (setq ent (ssname ents i))
    (setq elist (entget ent))
    (setq elist  (subst  (cons 40 yuk) (assoc 40 elist) elist))
    (entmod elist)
    (if (= 35 (getvar "ERRNO")) (princ "\nSeçtiğiniz yazı kilitli tabakada. Değiştirilemiyor."))
    (setq i (1+ i))
  );_while
  (command "undo" "end")
  (setvar "CMDECHO" 1)
  (princ (strcat "\n" (itoa i) " tane yazının boyu değiştirildi"))(princ)
);_ty
(defun c:tb(/ ob i ename yazi elist)
  (princ "\nBirleştirilecek yazıları seçiniz :")
  (if (setq ob (ssget '((0 . "TEXT"))))
    (progn
      (setq i 1 yazi "")
      (while (setq ename (ssname ob i))
        (setq yazi (strcat yazi (cdr (assoc 1 (entget ename))) " ")
              i (1+ i)
        )
        (entdel ename)
      );_while
      (setq elist (entget (ssname ob 0))
            elist (subst (cons 1 (strcat (cdr (assoc 1 elist)) " " yazi)) (assoc 1 elist) elist)
      )
      (entmod elist)
    );_progn
  );_if
 (princ)
);defun tb
;;;------------------------------------------------------------------------
(defun textuzunlugu(_yazi _yuk stil)
  (setq elist (list (cons 0 "TEXT")
		    (cons 1 _yazi)
		    (cons 7 (if stil stil "STANDARD"))
		    (cons 8 "0")
;;		    (cons 10 _nokta)
;;		    (cons 11 _nokta)
		    (cons 40 _yuk)
;		    (cons 50 (/ (* _aci PI) 180.0))
;		    (cons 72 _g72)
;		    (cons 73 _g73)
	      )
  )
  (setq kosegen (textbox elist))
  (setq bas (list (caar kosegen) (cadar kosegen));_sol-alt koordinat
        son (list (caadr kosegen) (cadar kosegen));_sağ-alt koordinat
  );_setq
  (distance bas son)
);_textuzunlugu
;;;------------------------------------------------------------------------
(defun text2list(yazi / i n txt kelime sonuc kar)
  (setq txt (vl-string-trim " \t" yazi) ;_ baş ve sondaki boşluklar atılıyor
        i 1
        n (strlen txt)
        kelime ""
        sonuc (list)
  )
  (repeat n
    (if (= (setq kar (substr txt i 1)) " ")
        (setq sonuc (append sonuc (list kelime))
              kelime ""
        )
        (setq kelime (strcat kelime kar))      
    );_if
    (setq i (1+ i))
  );_repeat
  (append sonuc (list kelime))
);_text2list
(defun otele-xy (n x y)
  (list (+ x (car n)) (+ y (cadr n)))
)
;;;------------------------------------------------------------------------
(defun c:tay( / a1 a7 a8 a10 a11 a40 a50 a72 a73 ent oldos elist txtlist kosegen dx ele)
  (if (setq ent (entsec "TEXT" "\nKelimelere ayrıştırılacak yazıyı seçiniz :"))
    (progn
      (setvar "CMDECHO" 0)
      (command "undo" "begin")
      (setq oldos (getvar "OSMODE"))
      (setvar "OSMODE" 0)
      (setq elist (entget ent)
            txtlist (text2list (cdr (assoc 1 elist)))
            a1 (assoc 1 elist)
            a7 (assoc 7 elist)
            a8 (assoc 8 elist)
            a10 (assoc 10 elist)
            a11 (assoc 11 elist)
            a40 (assoc 40 elist)
            a50 (assoc 50 elist)
            a72 (assoc 72 elist)
            a73 (assoc 73 elist)
      )
      (entdel ent)
      (setq elist (list (cons 0 "TEXT") a1 a8 a10 a40 a50))
      (if  a7 (setq elist (append elist (list a7 ))))
      (if a11 (setq elist (append elist (list a11))))
      (if a72 (setq elist (append elist (list a72))))
      (if a73 (setq elist (append elist (list a73))))
      (foreach ele txtlist
        (setq elist  (subst (cons 1 (strcat ele "_")) (assoc 1 elist) elist)
              kosegen (textbox elist)
              dx (- (caadr kosegen) (caar kosegen))
              ;dy (- (cadadr kosegen) (cadar kosegen))
        )
        (setq elist  (subst (cons 1 ele) (assoc 1 elist) elist))
        (entmake elist)
        (setq a10 (cons 10 (polar (cdr a10) (cdr a50) dx)))
        (setq elist (subst a10 (assoc 10 elist) elist))
        (if a11
          (setq a11 (cons 11 (polar (cdr a11) (cdr a50) dx))
                elist (subst a11 (assoc 11 elist) elist))
        )
      );_foreach
      (setvar "OSMODE" oldos)
      (command "undo" "end")
      (setvar "CMDECHO" 1)
    );_progn
  );_if
  (princ)
);_tay
;;;------------------------------------------------------------------------
(defun c:textsec( / kriter obj secim ename elist yazi i)
  (princ  "\nSeçim kriteri :")
  (if (setq kriter (read-line))
    (progn
      (princ "\nSeçilecek Yazıları gösteriniz :")
      (if (setq obj (ssget '((0 . "TEXT"))))
        (progn
          (setq secim (ssadd) i 0)
          (while (setq ename (ssname obj i))
            (setq elist (entget ename)
                  yazi (cdr (assoc 1 elist))
                  i (1+ i)
            )
            (if (wcmatch yazi kriter) (progn (ssadd ename secim) (redraw ename 3)))
          );_while
        );_progn
      );_if
    );_progn
  );_if
 (setq sayi (if secim (sslength secim) 0))
 (if (> sayi 0)
   (progn
     (command "SELECT" secim "")
     (princ (strcat "\nKritere uyan [ " (itoa sayi) " ] yazı bulundu."))
   )
   (princ "\nKritere uyan yazı bulunamadı")
 )
 (princ)
);_textsec
(princ "\nWild-card characters:")
(princ "\nCharacter Definition ")
(princ "\n# (pound) Matches any single numeric digit ")
(princ "\n@ (at) Matches any single alphabetic character ")
(princ "\n. (period) Matches any single nonalphanumeric character ")
(princ "\n* (asterisk) Matches any character sequence, including an empty one, and it can be used anywhere in the search pattern: at the beginning, middle, or end ")
(princ "\n? (question mark) Matches any single character ")
(princ "\n~ (tilde) If it is the first character in the pattern, it matches anything except the pattern ")
(princ "\n[...]  Matches any one of the characters enclosed ")
(princ "\n[~...]  Matches any single character not enclosed ")
(princ "\n- (hyphen) Used inside brackets to specify a range for a single character ")
(princ "\n, (comma) Separates two patterns ")
(princ "\n` (reverse quote) Escapes special characters (reads next character literally )")
;;;------------------------------------------------------------------------
;Derya KILIÇ eyl'2000 Oflaz İnşaat
;seçilen referans (TEXT ya da LINE)'a göre yazının açısını düzeltir.
(defun acibul(tip)
        (cond 
            ((= tip "LINE") 
              (setq aci (angle (cdr (assoc 10 obje)) (cdr (assoc 11 obje))))
            )
            ((= tip "TEXT")
              (setq aci (cdr (assoc 50 obje)))
            )
            (T 
              (princ "\nHATA : Referans obje LINE ya da TEXT olmalıdır !") (setq aci nil)
            )
   );cond
)
;;;------------------------------------------------------------------------
(defun c:ta( / obje tip aci ek yazi)
   (setq obje (entget (car (entsel "\nReferans Objeyi Seç (TEXT/LINE)"))))
   (setq tip (cdr (assoc 0 obje)))
   (setq aci (acibul tip) yazi T)
   (setq ek (getreal "\nReferans objeye olan aci <0>:"))
   (if (not ek) (setq ek 0.0))
   (setq aci (+ aci (* (/ ek 180.0) pi)))
   (if (> 270.0 aci 90.0) (setq aci (+ aci 180.0)))
   (while (and aci yazi)
        (setq yazi (entget (car (entsel "\nDüzeltilecek Yazıyı Seç :"))))
        (if yazi
              (progn 
                      (setq yazi  (subst  (cons 50 aci) (assoc 50 yazi) yazi))
                      (entmod yazi)
              )
        )
   );while
   (princ)
);defun ta
;;;------------------------------------------------------------------------
(defun c:tekle(/ ekyazi i obj elist ename)
  (princ "\nİşlenecek yazıları seçiniz :")
  (if (setq obj (ssget '((0 . "TEXT"))))
    (if (/= "" (setq ekyazi (getstring "\nEklenecek Yazı :")))
    	(progn
	  (initget "Bas Son")
	  (setq tercih (getkword "Başına mı Sonuna mı? [Bas/Son] <B> :"))
	  (if (null tercih) (setq tercih "B"))
          (command "undo" "begin")
          (setq i 0)
          (while (setq ename (ssname obj i))
            (setq elist (entget ename)
                      i (1+ i)
            )
            (if (= tercih "B")
	      (setq elist (subst (cons 1 (strcat ekyazi (cdr (assoc 1 elist)))) (assoc 1 elist) elist))
	      (setq elist (subst (cons 1 (strcat (cdr (assoc 1 elist)) ekyazi)) (assoc 1 elist) elist))
	    )
            (entmod elist)
          );_while
          (command "undo" "end")
       );_progn
     );_if
  );_if
);_tdeg
;;;------------------------------------------------------------------------
(defun c:text2dosya( / obj i ename elist ylist dosyayolu dosya)
  (if (setq dosyayolu (getfiled "Yazılacak Dosya" "" "txt" 1))
  (progn
    (princ "\nDosyaya yazılacak yazıları seçiniz :")
    (if (setq obj (ssget '((0 . "TEXT"))))
    	(progn
          (setq i 0)
          (while (setq ename (ssname obj i))
            (setq elist (entget ename) i (1+ i))
            (setq ylist (append ylist (list (list (cdr (assoc 10 elist)) (cdr (assoc 1 elist))))))
          );_while
          (setq ylist (yxsort ylist)
                slist nil
                sonlist nil
                onceki_y (cadar (car ylist))
          )
          (foreach ele ylist
            (if (not (equal onceki_y (cadar ele) 0.01)) ; y'ler eşit değilse yeni satıra geçiliyor..
              (setq sonlist (append sonlist (list slist))
                    slist nil
                    onceki_y (cadar ele)
              )
            );_if
            (setq slist (append slist (list (cadr ele))))
          );_foreach
          (setq sonlist (append sonlist (list slist)))
          (listeyi_dosyaya_yaz sonlist dosyayolu)
       );_progn
     );_if
  );_progn
  );_if
  (princ)
);_text2txt
;;;------------------------------------------------------------------------
;;;liste'nin yapısı : (((x1 y1 z1) "yazı1") ((x2 y2 z2) "yazı2") ... ((xn yn zn) "yazın"))
;;;önce y'ye göre (yukardan aşağı), sonra x'e göre (soldan sağa) sıralar
(defun yxsort (liste)
  (vl-sort liste
	   (function (lambda (e1 e2)
                       (if (equal (cadar e1) (cadar e2) 0.0001) ; y'ler eşit ise..
                         (< (caar e1) (caar e2))     ; x'e bak
                         (> (cadar e1) (cadar e2))   ; değilse y'ye bak
		       )
		     )
	   )
  )
) ;_yxsort
(defun listeyi_dosyaya_yaz(lst yol / satir dos eele ele)
  (setq dos (open yol "w"))
  (foreach ele lst
    (setq satir "")
    (foreach eele ele
      (setq satir (strcat satir eele "\t"))
    )
    (write-line satir dos)
    (write-line satir)
  )
  (close dos)
  (princ (strcat "\n" yol " dosyası yazıldı"))
);_listeyi_dosyaya_yaz
;;;------------------------------------------------------------------------
(defun harfcevir(__str __sec / __n __i __kar __bpos __kpos __sonuc __kp __sss)
  (setq buyukharflist
	 (list "A" "B" "C" "Ç" "D" "E" "F" "G" "Ğ" "H" "I" "İ" "J" "K" "L" "M"
	       "N" "O" "Ö" "P" "Q" "R" "S" "Ş" "T" "U" "Ü" "V" "W" "X" "Y" "Z")
	kucukharflist
	 (list "a" "b" "c" "ç" "d" "e" "f" "g" "ğ" "h" "ı" "i" "j" "k" "l" "m"
	       "n" "o" "ö" "p" "q" "r" "s" "ş" "t" "u" "ü" "v" "w" "x" "y" "z")
  )
;;;----------------------------------------------------------------------------
;;; verilen dizgenin yalnızca baş harfini büyük yapar..
  (defun basharfibuyut(__s)
    (if (setq __kp (vl-position (substr __s 1 1) kucukharflist))
      (strcat (nth __kp buyukharflist) (substr __s 2))
      __s
    )
  );_basharfibuyut
;;;----------------------------------------------------------------------------
  (defun kucukharfecevir(__harf / __bpos)
    (setq __bpos (vl-position __harf buyukharflist))
    (if __bpos (nth __bpos kucukharflist) __harf)
  );_kucukharfecevir
;;;----------------------------------------------------------------------------
  (defun buyukharfecevir(__harf / __kpos)
    (setq __kpos (vl-position __harf kucukharflist))
    (if __kpos (nth __kpos buyukharflist) __harf)
  );_buyukharfecevir
;;;----------------------------------------------------------------------------
  (defun tersharfecevir(__harf / __kpos __bpos)
    (setq __kpos (vl-position __harf kucukharflist)
          __bpos (vl-position __harf buyukharflist))
    (if __kpos
      (nth __kpos buyukharflist)
      (if __bpos
	(nth __bpos kucukharflist)
	__harf
      )
    );_if
  );_tersharfecevir
;;;----------------------------------------------------------------------------
  (setq __n (strlen __str) __i 1 __sonuc "")
  (cond
    ((= __sec 1) ;;; tümü büyük harf
     (repeat __n (setq __sonuc (strcat __sonuc (buyukharfecevir (substr __str __i 1))) __i (1+ __i)))
    )
    ((= __sec 2) ;;; tümü küçük harf
     (repeat __n (setq __sonuc (strcat __sonuc (kucukharfecevir (substr __str __i 1))) __i (1+ __i)))
    )
    ((= __sec 3) ;;; büyükler küçük, küçükler büyük harf
     (repeat __n (setq __sonuc (strcat __sonuc (tersharfecevir  (substr __str __i 1))) __i (1+ __i)))
    )
    ((= __sec 4)
     (repeat __n (setq __sonuc (strcat __sonuc (kucukharfecevir (substr __str __i 1))) __i (1+ __i)))
     (setq __sonuc (strcat (buyukharfecevir (substr __sonuc 1 1)) (substr __sonuc 2)))
    )
    ((= __sec 5)
         (while (<= __i __n)
	   (setq __sss "")
	   (while (and (<= __i __n) (/= " " (setq __kar (substr __str __i 1))))
	    (setq __sss (strcat __sss (kucukharfecevir __kar)) __i (1+ __i))
	   );_while
	   (setq __sonuc (strcat __sonuc " " (basharfibuyut __sss)))
	   (setq __i (1+ __i))
         );_while
	 (setq __sonuc (substr __sonuc 2)) ;; ilk baştaki boşluk atılıyor..
    )
  );_cond
  __sonuc
);_harfcevir
;;;----------------------------------------------------------------------------
;;;----------------------------------------------------------------------------
;;;----------------------------------------------------------------------------
(defun c:harfcev( / dcl_id sec flag obje i ename elist)
  (setq dcl_id (load_dialog "text.dcl"))
  (if (new_dialog "harfcevirdlg" dcl_id)
    (progn
      (action_tile "accept" "(setq sec (get_tile \"secenek\"))(done_dialog 1)")
      (action_tile "bilgi" "(alert \"Çizimdeki yazıları düzenler\n\n Derya KILIÇ\nTem'2003\")")
      (setq flag (start_dialog))
      (if (= flag 1)
        (if (setq obje (ssget '((0 . "TEXT"))))
	  (progn
	    (setq i 0)
	    (while (setq ename (ssname obje i))
	      (setq elist (entget ename))
              (setq elist  (subst (cons 1 (harfcevir (cdr (assoc 1 elist)) (atoi sec))) (assoc 1 elist) elist))
	      (entmod elist)
	      (setq i (1+ i))
	    )
            (princ (strcat "\n" (itoa i) " adet yazı düzeltildi"))
	  );_progn
	);_if
      );_if
      (unload_dialog dcl_id)
    )
    (princ "text.dcl dosyası yüklenemedi")
  )
  (princ)
)
;;;c:tyd()-Text Yer Degistir---------------------------------------------------
;;;seçilen iki TEXT nesnesinin yerlerini değiş-tokuş eder----------------------
;;;----------------------------------------------------------------------------
(defun c:tyd( / tename1 tename2 telist1 telist2 y1 y2 dxf1 dxf2)
  (setq tename1 (entsec "TEXT" "1. Yazıyı seçiniz :")
	tename2 (entsec "TEXT" "2. Yazıyı seçiniz :")
  )
  (if (and tename1 tename2)
    (progn
      (setq telist1 (entget tename1)
	    telist2 (entget tename2)
	    y1 (cdr (assoc 11 telist1))
            y2 (cdr (assoc 11 telist2))
	    dxf1 11 dxf2 11
	    
      )
      (if (equal y1 (list 0.0 0.0 0.0)) (setq dxf1 10 y1 (cdr (assoc dxf1 telist1))))
      (if (equal y2 (list 0.0 0.0 0.0)) (setq dxf2 10 y2 (cdr (assoc dxf2 telist2))))
      
      (setq telist1 (subst (cons dxf1 y2) (assoc dxf1 telist1) telist1))
      (entmod telist1)
      (setq telist2 (subst (cons dxf2 y1) (assoc dxf2 telist2) telist2))
      (entmod telist2)
    )
  );_if
  (princ)
);_c:tyd
(princ "\n © ²°°°[TES],[TY],[TA],[TB],[TAY],[TEXTSEC],[TEKLE],[TEXT2DOSYA][HARFCEV][TYD] dꮥå\n")
(princ "\n © Derya KILIÇ\n")(princ)