11.01.2012 15:02    

reverdi
Arkadaşlar,aşağıda verdiğim lisp çalışıyor fakat,autocad dosyasında çalışırken baska bir dosya açtığınızda text editorun de 3 defa yazı boyunu değiştirmeniz gerekiyor tekrar doğru çalışması için.Yani hem yanlış alan hesaplıyo hemde text boyutu değişiyor.text boyutunu ayarladıktan sonra doğru çalışmaya başlıyor.
Lispin kullanımı : çağırdıktan sonra 'al' konutuyla çalışıyor.alanları seciosunuz ve toplamını yazıyor.

Bu konuda acil yardım lazım...


Kod:

(Defun myerrora (S_CLV)
   (If (/= S_CLV "Function cancelled")
       (Princ (Strcat "\n Error:  " S_CLV))
(progn
(setvar "osmode" os_al)
(Command "_layer" "on" "Center" "")
(Command "_layer" "on" "kot" "")
(Command "undo" "end")
(setvar "cmdecho" cmd)
   ))
   (Setvar *error* olderr)
   (Princ)
   (Terpri)
   (Terpri))
(defun c:al (/ ae)
(Setq olderr *error* *error* myerrora)
(Command "undo" "be")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq os_al (getvar "osmode"))
(setvar "osmode" 0)
(setq lis 0)
(setq llis (list lis))
(Command "_layer" "off" "Center" "")
(Command "_layer" "off" "kot" "")
(setq a (getpoint "\n nokta seç"))
(terpri)
(setq say 0)
(while (/= a nil)
(setq a1 (command "boundary" a ""))
(setq a2 (entlast))
(if (/= a nil)
(progn
(command "area" "o" a2)
(setq ae (getvar "area"))
(command "erase"  (entlast) "")
(princ ae)
(terpri)
(terpri)
(setq llis (cons ae llis))
(setq llis (list (apply  '+ llis)))
(princ llis)
(terpri)
(setq a (getpoint "\n nokta seç"))
)))
(setq tza (getvar "textsize"))
(setq say (rtos (car llis) 2 3))
(setq po (getpoint "\nAlan nereye yazılacak"))
(terpri)
(Command "text" po tza "0.75" say)
(Command "_layer" "on" "Center" "")
(Command "_layer" "on" "kot" "")
(setvar "osmode" os_al)
(Command "undo" "end")
(setvar "cmdecho" cmd)
)

ehya (11.01.2012 15:09 GMT)

11.01.2012 18:25    

ProhibiT
Verdiğiniz kod pek elle tutulur olmadığından, hatanın ne olduğu ve nereden kaynaklandığını bulmaya çalışmak eziyetli bir iş. Bahsettiğiniz işi daha derli toplu yapacak bir Fonksiyon yazdım. Bunu Kullanmanızı tavsiye ederim. Alan hesabına esas Bundary objeleri seçilirken, Kot ve Center Layer'larını işleme almayacak şekilde algoritma kurdum. Bu şekilde Gözardı edilmesini istediğiniz başka Layer'lar olursa; '(8 . "KoT,CenTer") bölümüne, aralarına virgül koyarak Layer adlarını yazmanız yeterli olacaktır.
Kod:

;|===========================================================================|;
;|      Hazırlayan: M. Şahin Güvercin  11/01/2012  www.autocadokulu.com      |;
;|___________________________________________________________________________|;
(write-line "Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com")
(defun c:aL (/ *error* ALan ToTaR BnSet TxH Dpp PnT Yaz SoB BnDry Tus)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (defun *error* (er)
    (command "_.Undo" "e") (setvar "DimZin" Odz) (princ (strcat "\n" er)))
  (setq Odz (getvar "DimZin") ALan 0 ToTaR 0 BnSet (ssadd)) (setvar "dimzin" 1)
  (setq TxH (getreal (strcat "\nYazı Yüksekliği <"
                (if oTx (rtos oTx) (rtos (getvar "TextSize"))) ">: ")))
  (if TxH (setq oTx TxH) (if oTx (setq TxH oTx)(setq TxH (getvar "TextSize"))))
  (setq Dpp (getint (strcat "\nOndalık Basamak <"
                (if Odp (itoa Odp) (itoa (getvar "Luprec"))) ">: ")))
  (if Dpp (setq Odp Dpp) (if Odp (setq Dpp Odp) (setq Dpp (getvar "Luprec"))))
  (princ "\n") (setq Yaz (strcat "  Alan: " (rtos ALan 2 Dpp) "  Toplam Alan: "
                                 (rtos ToTaR 2 Dpp)) SoB (entlast))
  (setq PnT (getpoint (strcat "\r Nokta Seçiniz: " Yaz)))
  (while PnT (command "_.Boundary" PnT "")
    (if (not (eq (entlast) SoB)) (progn (setq SoB (entlast))
        (setq BnDry (entlast)) (ssadd BnDry BnSet) (sssetfirst nil BnSet)
        (setq ToTaR (+ ToTaR (setq ALan (vlax-get-property
                                       (vlax-ename->vla-object BnDry) 'Area))))
        (princ (setq Yaz (strcat "  Alan: " (rtos ALan 2 Dpp)
                                 "   Toplam Alan: " (rtos ToTaR 2 Dpp))))))
    (setq PnT (getpoint (strcat "\r Nokta Seçiniz: " Yaz))))
  (entmake (list '(0 . "TEXT") '(10 0.0 0.0 0.0) (cons 40 TxH)
           (cons 1 (rtos ToTaR 2 Dpp)) '(50 . 0.0) '(72 . 1) '(11 0.0 0.0 0.0)))
  (setq TxA (vlax-ename->vla-object (entlast)) onK '(0.0 0.0 0.0)
        TxE (vlax-vla-object->ename TxA) MoB nil)
  (while (and (/= 3 (setq Tus (car (setq nnK (grread T 4 0)))))
             (/= 2 Tus) (/= 25 Tus)) (if MoB (redraw MoB 4))
    (setq nnK (cadr nnK)) (vla-transformby TxA (vlax-tmatrix (list
                                           (list 1 0 0 (- (car nnK) (car onK)))
                                         (list 0 1 0 (- (cadr nnK) (cadr onK)))
                                       (list 0 0 1 (- (caddr nnK) (caddr onK)))
                                      (list 0 0 0 1))))
    (entdel TxE) (if (setq MoB (ssget nnK (list (cons 0 "*Text"))))
                   (redraw (setq MoB (ssname MoB 0)) 3)) (entdel TxE)
    (setq onK nnK)) (if (= Tus 3) (if MoB (progn (setq MoB (entget MoB)
              MoB (subst (cons 1 (rtos ToTaR 2 Dpp)) (assoc 1 MoB) MoB))
        (entmod MoB) (entupd (cdr (assoc -1 MoB))) (vla-erase TxA)))
     (entdel TxE)) (command "_.Erase" BnSet "")
  (setvar "DimZin" Odz) (command "_.Undo" "e") (prin1))
;|___________________________________________________________________________|;
Toplam alan yazısı belirlediğiniz Yazı Yüksekliğinde ve gene belirlediğiniz ondalık basamak sayısında Cursor'ınızın ucunda belirecek, mouse ile hareket ettirip, istediğiniz yere tıklayarak yerleştirebilirsiniz.

Kolay Gelsin.

ProhibiT (13.01.2012 14:38 GMT)

13.01.2012 08:44    

TENTEN143
Prohibit bunun kısayoluda "al" mı ? denedim bende autocada ait align komutu çalışıyor aligni değiştirdim fakat senin kini çalıştıramadım,rica etsem sen yükler misin lispi !

ehya (13.01.2012 11:20 GMT)

13.01.2012 11:19    

ehya
tenten143

tam bir tentenlik yapıyorsun. Ne demek "prohibit kardeş". Şu basit forum ağzını bırakın artık. "Kardeş" diye hitap ettiğin şahıs belki babandan da büyük bir hocamız.
Son kez uyarıyorum. Bundan böyle klasik forum ağzıyla yazılan mesajlar sorgusuz sualsiz silinecektir.

13.01.2012 15:12    

ProhibiT
Arkadaşlar fonksiyonu düzenleyip, yeniden yükledim.
- Toplam alanı yazarken bir hata vardı, toplam alan yerine son seçilen bölge alanı yazıyordu. Düzeltildi.
- Toplam alan yazısı ekranda belirip yeri belirlenmek üzere sürüklenirken, ilgili yerde Mevcut bir text objesi varsa, onun içeriği değiştirilecek, boş bir yer ise yeni text oluşturacak şekilde değişiklik yapıldı.

13.10.2014 08:08    

hnfkz
merhabalar, lispi yükledim, aln enter yaptığımda;
Command: aln ALn:dialog{
label="**** Alan Hesaplama ve Yazdırma ****";
: boxed_column{
: edit_box{label=" Yazılacak Birim/Çizim Birimi:";key="Luf";edit_width=4;}
: edit_box{label="Ondalık Basamak Sayısı:";key="dpL";edit_width=4;}
: edit_box{label=" Yazı Yüksekliği:";key="txh";edit_width=4;}
: edit_box{label=" Alan Yazısı Öneki:";key="Lea";edit_width=4;}
: edit_box{label=" Alan Yazısı Soneki:";key="Tra";edit_width=4;}
: toggle{label=" Çevre Yazılacak mı?:";key="Cvr";}
spacer;spacer;}
: boxed_row{: text{key="CpR";value=
" Hazırlayan:M.Şahin Güvercin - www.cizimokulu.com"
;}}
ok_cancel;}
; error: bad argument type: streamp nil


hatasını veriyor. ne yapmalıyım?

13.10.2014 19:50    

ProhibiT
Kestirme ama geçici bir çözüm olarak; AutoCAD icon'u üzerine sağ tıklayıp "Yönetici olarak çalıştır / veya Run as administrator" seçerek AutoCAD'i açtığınızda bahsettiğiniz problemi yaşamazsınız.

Problemin kökten ve kalıcı çözümü için;


Linkleri görebilmek için ÜYE olmalısınız.




Linkleri görebilmek için ÜYE olmalısınız.




Linkleri görebilmek için ÜYE olmalısınız.




Linkleri görebilmek için ÜYE olmalısınız.


Linklerinde açıklanan işlemleri uygulamalı, kendinize AutoCAD klasörlerinde yeterli erişim yetkisi tanımlamalısınız.

> 1 <
Copyright © 2004-2022 SQL: 1.007 saniye - Sorgu: 62 - Ortalama: 0.01624 saniye