;;;Dikkat:Asagidaki aciklamalar orta ve ust duzey lisp
;;; programi ile ilgilenen kullanicilar icindir.
;;;
;;;asagidaki satirlari copy komutuyla alip notepad i
;;;actiktan sonra paste ile yapistirin. Text dosyasinin
;;; adini duzenleyin ve uzantisini *.lsp yapin. Autocadi
;;;acin ve "appload" komutuyla bu dosyayi bulup yukleyin.
;;;calistirmak icin komut satirindan "ss" yazip entere basin.
;;;* *
;;;*                         =) freeMUST =)                  ;;;* *
;;;*                        Bilgi evrenseldir *
;;;*                      paylasmak mutluluktur *
;;;*                      freemust@gmail.com             ;;;* *
;;;Asagidaki lisp sadece "lwpline" lardan olusan bir secim seti olusturur.
;;;Herbir pline in baslangic ve bitis noktasindan bir cizgi cizer ve "pedit"
;;;komutuyla son cizilen cizginin bir butun olmasini saglar. SOn olarak da
;;;uclari kapatilarak olusturulan yeni pline in alanini yazar.
;;;* *
(DEFUN C:ss (/      secim_kumesi    sayac      siradaki_pline
     pl_ozellik      pl_nokta      pl_ilk_nokta    pl_son_nokta
     pl_alan      pl_toplam_alan
    )
   ;;bir secim_kumesi olustur. ssget komutu icindeki '((0 . "LWPOLYLINE"))
   ;;kismi sadece pline leri secmek icin kullanilir istenirse bu kisim komut satirindan cikaribilir.
   (setq secim_kumesi (ssget '((0 . "LWPOLYLINE"))))

   ;; pl_toplam_alan degiskeni olustur ve sifir degeri ata
   (setq pl_toplam_alan 0)
   ;; sayac degiskeni olustur ve sifir degeri ata
   (setq sayac 0)

   ;;sayacin sifir degeri asagida yerine konur. secim_kumesi icindeki ilk
   ;;nesneye ait, acad icindeki gomulu obje koduna ulasilir.
   (setq siradaki_pline (ssname secim_kumesi sayac))

   ;;secim_kumesi icindeki nesne kodlari oldugu surece gongu devam eder.
   ;;siradaki_pline degeri "t"yada"true" oldugu surece dongu surer.
   ;;"t"yada"true" demek siradaki_pline degerinin varligi ve bir deger
   ;;alabildigi anlamina gelir. eger siradaki_pline=nil oldugunda
   ;;while dongusunden cikilir. asagida; siradaki_pline=nil degerini
   ;;sadece secim kumesinde hicbir eleman kalmadiginda alir.
   (while siradaki_pline
      ;;siradaki_pline obje koduna ait nesneyi olusturan butun ozelliklere
      ;;ulasilir.istenirse bunlar (print pl_ozellik) diyerek gorulur

      (setq pl_ozellik (entget siradaki_pline))
;;;      (print pl_ozellik)
      ;;bu nese ozellikleri listesinden pline baslangic noktasi koduna
      ;;ulasilir. Acad icinde nesne baslangic kodlari = 10 dur. ve
      ;; (...... ( 10 "x koord" "z koord" "z koord") .... ) seklindedir.
      (setq pl_nokta (assoc 10 pl_ozellik))

      ;;buldugumuz ilk noktayi (pl_nokta), pl_ilk_nokta degerine atiyoruz
      (setq pl_ilk_nokta (cdr pl_nokta))


      ;;secilen pline ait noktalar oldugu surece while dondusu surer.
      (while pl_nokta
;;dongude bulunan noktayi pl_son_nokta degerine atayıyoruz
(setq pl_son_nokta (cdr pl_nokta))
;;burasi onemli... yukardaki (print pl_ozellik) komutu kullanarak
;;ekranda yazanlara bakmissaniz pek cok nokta oldugu gorulur.
;;biz sirasiyla bu pl_ozellik icindeki noktalari listeden cikarip
;;kalan listeyi tekrar pl_ozellik degerine atayacagiz ki bir
;;sonraki while dongusunde kullanalim.
(setq pl_ozellik (cdr (member pl_nokta pl_ozellik)))
;;while nin donguye devam etmesi icin, hala nokta (pl_nokta degeri yani)
;;varmi diye bakiyoruz.
(setq pl_nokta (assoc 10 pl_ozellik))
      )


      ;;pline ait baslangic ve son noktaya cizgi cizer
      (command "_.line" pl_ilk_nokta pl_son_nokta "")

      ;;simdi bu cizgiyi siradaki_pline son olusturulan cizgiyi birlestirecegiz.
      (command "_.pedit" siradaki_pline "_join" "_last" "" "")

      ;;pline ait alan bulunur
      (command "_.area" "_o" siradaki_pline)
      (setq pl_alan (getvar "area"))
      ;; alan yazdirilir
      (princ (strcat "n" (itoa (1+ sayac)) ". pline alani = " (rtos pl_alan 2)))
      ;;bulunan alan tolam alan icine eklenir
      (setq pl_toplam_alan (+ pl_toplam_alan pl_alan))

      ;;sayac degerini while dongusu icin bir arttiralim ki secim setindeki
      ;;diger pline lara ulasalim.
      (setq sayac (1+ sayac))
      ;;siradaki_pline=true kontrolu... yani secim setinde baska sectigimiz
      ;;pline var mi. Eger yoksa yani siradaki_pline=nil ise donguden cikilir
      (setq siradaki_pline (ssname secim_kumesi sayac))
   )
   (princ (strcat "ntoplam pline alani = " (rtos pl_toplam_alan 2)))
   (princ)
)
(PRINC "--> 'www.autocadokulu.com' Çizim yardımları yüklendi !")