Reklam

* E Posta Adresiniz:
* Kodu Girin:

Pline 'ları seçen, uçlarını kapatan ve hepsinin alanlarını bulan lisp

Polyline objeleri seçip uçlarını kapatan ve hepsinin alanlarını bulan lisp dosyası. Hakediş yapanların çok işine yarayacaktır.
freemust - 28.03.2005 02:42
Yazar: freeMUST =)
İçerik:

(Kontrol panelinizde görünür)

Pline'ları (polyline) seçen, uçlarını kapatan ve hepsinin alanlarını bulan lisp fonksiyonu



Hakediş yapanların çok işine yarayacaktır.

Buraya tıklayarak açılan pencereden AutoLISP kodlarını Ctrl + C ile kopyalayabilirsiniz
Kod:

;;;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 !")


Bu kodları nasıl kullanacağınızı bilmiyorsanız aşağıdaki linkten;
AutoLISP > Konu Anlatımları > Lisp Dosyalarının oluşturulması ve Yüklenmesi
konusunu inceleyiniz.
Yorumlar :
4935   29.02.2016 19:10 #15641  

merhabalar lisp guzel calısıyor ve objelerıde secıyoruz secım bıttıkten sonra bır suru komut satrında bırsuru sey cıkıyor bız hangısını secipde sonuçları gorecegız lutfen detaylı bırsey yazın tesekur ederım

cessabata   31.07.2015 08:47 #15580  

merhabalar lisp guzel calısıyor ve objelerıde secıyoruz secım bıttıkten sonra bır suru komut satrında bırsuru sey cıkıyor bız hangısını secipde sonuçları gorecegız lutfen detaylı bırsey yazın tesekur ederım

reverdi   17.09.2011 18:38 #14271  

Nasıl çalışıyor bu lisp acaba _?açık bi şekilde anlatırmısınız_...

zigach   15.10.2009 14:27 #11870  

polyline lar kapalı olunca çalışmıyor. yane ben bir cok kapalı alanı bir kerede toplamaya çalışıyorum olmuyr.

zigach   15.10.2009 14:18 #11869  

iyide kopyalanmıyro yazılar

mmt84   07.06.2009 04:47 #11246  

teşekkürler

dmc_xx   21.04.2009 18:23 #10976  

teşekkurler

sgadarkelf   09.04.2009 20:43 #10900  

ss yazınca olmuyo kodu verirmisniz düzeltip?

nrreko   28.01.2009 13:26 #10271  

çalışırsa süper

ehya   19.09.2007 13:02 #5635  

sessiz kabus.
Baktığın tüm lisplere çalışmıyor diyorsun. Ya bi kontrol et. Öyle çalışmıyor de.. Lisplerde sorun yok. Tekrar kontrol et.

Sessiz Kabus   19.09.2007 12:37 #5628  

ss komut hatası veriyor üstad.

serii_girl ;   28.03.2007 15:55 #3634  

ben bu dosyayı çalıştıramadım..ss yazdım komut olarak çalışmıyor

yoruk1919   25.09.2006 20:32 #653  

Henüz denemedim, düşünce harika, çalışacağındanda eminim teşekkür ederim.

Copyright © 2004-2018 | Tüm Hakları Saklıdır | 1355 | Site haritası | İstatistikler | Hakkımızda | Kadromuz | Gizlilik | Reklam