27.04.2013 18:13    

thrcr
Kod:

(defun c:cone (/ sd d H sr R X thick deg xp1 xp2 yp1 yp2)

(setq d (getreal "\nBüyük çapı giriniz. "))
(setq sd (getreal "\nKüçük çapı giriniz. "))
(setq H (getreal "\Yükeklik giriniz. "))
(setq thick (getreal "\nSac kalınlığı. ")) 

(setq d (+ d (/ (* (* 2 (cos (atan (/ H (/(- d sd) 2 ))))) thick) 2)))
(setq sd (+ sd (/ (* (* 2 (cos (atan (/ H (/(- d sd) 2 ))))) thick) 2))) 
(setq x (expt (+ (expt (/ (- d sd) 2) 2) (expt H 2)) 0.5))
(setq sr (/ (* sd x) (- d sd)))
(setq R (+ sr X) )
(setq deg (*(/ d R) 180))

;area = (R ^ 2 - sr ^ 2) * deg / 360 * 3.14159
;wt = area / 144 * thick * 40.8

(If (<= deg 180) (progn
        (setq yp1 ( * R  (Sin (*(/ 3.14159 180)  (/  (- 180  deg)  2)))))
    (setq xp1 ( * R  (cos (*(/ 3.14159 180)  (/  (- 180  deg)  2)))))
        (setq yp2 ( * sr  (Sin (*(/ 3.14159 180)  (/  (- 180  deg)  2)))))
        (setq xp2 ( * sr  (cos (*(/ 3.14159 180)  (/  (- 180  deg)  2)))))
       (command "Line" (strcat (rtos xp2) "," (rtos yp2))   (strcat "@" (rtos (- R  sr)) "<"  (rtos (/(- 180  deg)  2))) "")
    (command "_zoom" "e")
    (command "_zoom" ".5xp")
    (command "copy" "la" "" "0,0" "0,0")
    (command "_zoom" "e")
    (command "_zoom" ".5xp")
    (command "rotate" "la" "" "0,0" deg)
    (command "arc" (strcat(rtos xp1) "," (rtos yp1) ) (strcat "0," (rtos R))  (strcat "-" (rtos xp1) "," (rtos yp1) ))
    (command "arc" (strcat(rtos xp2) "," (rtos yp2) ) (strcat "0," (rtos sr))  (strcat "-" (rtos xp2) "," (rtos yp2) ))
    (command "_zoom" "e")
    )
      (progn
        (If (> deg  270)(progn
                (setq yp1  (* R  (Sin (*(Atan 1) ( *(/ (- deg 270)180)4)))))
                (setq xp1  (* R  (COS (*(Atan 1) ( *(/ (- deg 270)180)4)))))
        (setq yp2  (* sr  (sin (*(Atan 1) ( *(/ (- deg 270)180)4)))))
                (setq xp2  (* sr  (COS (*(Atan 1) ( *(/ (- deg 270)180)4)))))
               )
          (progn
                (setq yp1  (* (- R)  (Sin (*(Atan 1) ( *(/ (- 270 deg)180)4)))))
                (setq xp1  (* R  (cos (*(Atan 1) ( *(/ (- 270 deg)180)4)))))
        (setq yp2  (* (- sr)  (Sin (*(Atan 1) ( *(/ (- 270 deg)180)4)))))
                (setq xp2  (* sr  (cos (*(Atan 1) ( *(/ (- 270 deg)180)4)))))
              )
    )
    (command "line" (strcat "0," (rtos sr)) (strcat "@" (rtos (- R sr)) "<90") "")
        (command "line" (strcat (rtos xp1) "," (rtos yp1))(strcat(rtos xp2) "," (rtos yp2)) "")
    (command "_zoom" "e")
    (command "_zoom" ".5xp")
    (command "arc" (strcat "0," (rtos R)) (strcat "-" (rtos R) ",0")(strcat(rtos xp1) "," (rtos yp1)))
    (command "arc" (strcat "0," (rtos sr)) (strcat"-" (rtos sr) ",0")(strcat(rtos xp2) "," (rtos yp2)))
    (command "_zoom" "e")
    )
)
)





bu lisp appload yaptığında çalışıyor fakat kapatıp açtığımda tekrar yüklemem gerekiyor. Bunu nasıl halledebilirim yardımcı olur musunuz.
Bu arada başka lispler yüklü sıkıntı olmuyor bunun gibi bir kaç lisp var. autocad 2013 kullanıyorum. Yardımcı olan arkadaşa şimdiden teşekkür ederim

ehya (27.04.2013 18:32 GMT)

27.04.2013 18:33    

ehya
APPLOAD tablosunda CONTENTS kısmına lisplerini ekleyin.

27.04.2013 20:57    

thrcr
Alıntı
ehya :
APPLOAD tablosunda CONTENTS kısmına lisplerini ekleyin.




contents bölümüne lispleri ekliyorum ama bazı lispler çalışırken bazıları çalışmıyor. bunun sebebi veya çözümü nedir anlatmak istediğim bu aslında

27.04.2013 21:03    

ehya
Lisp kodu hatalı değil ise, çalışmama gibi bir durum söz konusu olamaz..

28.04.2013 14:36    

thrcr
autocad 2011 de çalışıyor unutma sorunu olmuyor işletim sistemi win7
aynı işletim sistemine 2013 kurduğumda bazı lispleri unutuyor bazılarını unutmuyor. buraya yazdığım da unutulanlardan bu benim için çok gerekli

uardımcı olursanız sevinirim.

28.04.2013 14:38    

thrcr
;kesitteki alanları toplar ve gösterilen yazının içeriğine yazar

(defun c:ay(/ yazi elist obj n i alan obje)
(setq stylelist (tblsearch "style" (getvar "TEXTSTYLE")))
(if (/= (cdr (assoc 40 stylelist)) 0.0)
(command "-STYLE" "" "" 0.0 "" "" "" "")
)
(princ "\nToplamı yazılacak alanları seçiniz :")
(setq obj (ssget '((0 . "LWPOLYLINE"))))
(setq n (sslength obj) i 0 alan 0.0)
(repeat n
(setq obje (ssname obj i))
(command "area" "o" obje)
(setq alan (+ alan (getvar "area")))
(setq i (1+ i))
);repeat
(princ (strcat "Toplam " (itoa n) " Alan = " (rtos alan 2 (getvar "LUPREC")) " mm²"))
(setq yazi (strcat (rtos alan 2 2) " mm²"))
;;;(setq yazi (strcat "%%u" (rtos alan 2 2) " mm²"))
; (setq yazi (rtos alan 2 2))
(setq elist (entget (car (entsel "\nHedef Yazıyı Seç :"))))
(setq elist (subst (cons 1 yazi) (assoc 1 elist) elist))
(entmod elist)
(princ)
);defun

(princ)


(defun c:ad(/ stylelist obj n i alan obje elist ec carpan hyazi yazi)
(setq stylelist (tblsearch "style" (getvar "TEXTSTYLE")))
(if (/= (cdr (assoc 40 stylelist)) 0.0)
(command "-STYLE" "" "" 0.0 "" "" "" "")
)
(princ "\nToplamı düşülecek alanları seçiniz :")
(setq obj (ssget '((0 . "LWPOLYLINE"))))
(setq n (sslength obj) i 0 alan 0.0)
(repeat n
(setq obje (ssname obj i))
(command "area" "o" obje)
(setq alan (+ alan (getvar "area")))
(setq i (1+ i))
);repeat
(princ (strcat "Toplam " (itoa n) " Alan = " (rtos alan 2 3) " mm²"))
(setq elist (entget (car (entsel "\nHedef Yazıyı Seç :"))))
(initget "Ekle Cikar")
(setq ec (getkword "Ekle Cikar <ekle>"))
(setq carpan (if (or (not ec) (= ec "Ekle")) 1.0 -1.0))
(setq hyazi (cdr (assoc 1 elist)))
(setq hyazi (distof (substr hyazi 1 (- (strlen hyazi) 3))))
(setq yazi (strcat (rtos (+ hyazi (* carpan alan)) 2 2) " mm²"))
(princ (strcat (rtos hyazi 2 2) " + " (rtos (* carpan alan) 2 2) " = " yazi))
(setvar "cmdecho" 0)
(command "undo" "m")
(setvar "cmdecho" 1)
(setq elist (subst (cons 1 yazi) (assoc 1 elist) elist))
(entmod elist)
(princ)
);defun
(defun c:ayy(/ yazi elist alan obje nokta al hedef son stylelist)
(setq stylelist (tblsearch "style" (getvar "TEXTSTYLE")))
(if (/= (cdr (assoc 40 stylelist)) 0.0)
(command "-STYLE" "" "" 0.0 "" "" "" "")
)
(setq obje (entsel "\nYazılacak alanı seçiniz :"))
(setq al (car obje) nokta (car (cdr obje)))

(command "AREA" "o" al)

(if al (setq alan (getvar "AREA")))
(princ (strcat " Alan = " (rtos alan 2 3) " mm²"))
; (setq yazi (strcat (rtos alan 2 2) " mm²"))
(setq yazi (strcat "%%U" (rtos alan 2 2) " mm²"))
; (setq yazi (strcat "%%U" (rtos alan 2 2)))
(setq hedef (car (entsel "\nHedef Yazıyı Seç <oluştur>:")))

(if hedef
(progn
(setq elist (entget hedef))
(setq elist (subst (cons 1 yazi) (assoc 1 elist) elist))
(entmod elist)
)
(progn
(setq _oldos_ (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq son (getpoint nokta))
(command "LEADER" nokta son "" "" "N")
(command "TEXT" son "" 0.0 yazi "")
(setvar "OSMODE" _oldos_)
)
);if
(princ)

28.04.2013 14:38    

thrcr
;kesitteki alanları toplar ve gösterilen yazının içeriğine yazar

(defun c:ay(/ yazi elist obj n i alan obje)
(setq stylelist (tblsearch "style" (getvar "TEXTSTYLE")))
(if (/= (cdr (assoc 40 stylelist)) 0.0)
(command "-STYLE" "" "" 0.0 "" "" "" "")
)
(princ "\nToplamı yazılacak alanları seçiniz :")
(setq obj (ssget '((0 . "LWPOLYLINE"))))
(setq n (sslength obj) i 0 alan 0.0)
(repeat n
(setq obje (ssname obj i))
(command "area" "o" obje)
(setq alan (+ alan (getvar "area")))
(setq i (1+ i))
);repeat
(princ (strcat "Toplam " (itoa n) " Alan = " (rtos alan 2 (getvar "LUPREC")) " mm²"))
(setq yazi (strcat (rtos alan 2 2) " mm²"))
;;;(setq yazi (strcat "%%u" (rtos alan 2 2) " mm²"))
; (setq yazi (rtos alan 2 2))
(setq elist (entget (car (entsel "\nHedef Yazıyı Seç :"))))
(setq elist (subst (cons 1 yazi) (assoc 1 elist) elist))
(entmod elist)
(princ)
);defun

(princ)


(defun c:ad(/ stylelist obj n i alan obje elist ec carpan hyazi yazi)
(setq stylelist (tblsearch "style" (getvar "TEXTSTYLE")))
(if (/= (cdr (assoc 40 stylelist)) 0.0)
(command "-STYLE" "" "" 0.0 "" "" "" "")
)
(princ "\nToplamı düşülecek alanları seçiniz :")
(setq obj (ssget '((0 . "LWPOLYLINE"))))
(setq n (sslength obj) i 0 alan 0.0)
(repeat n
(setq obje (ssname obj i))
(command "area" "o" obje)
(setq alan (+ alan (getvar "area")))
(setq i (1+ i))
);repeat
(princ (strcat "Toplam " (itoa n) " Alan = " (rtos alan 2 3) " mm²"))
(setq elist (entget (car (entsel "\nHedef Yazıyı Seç :"))))
(initget "Ekle Cikar")
(setq ec (getkword "Ekle Cikar <ekle>"))
(setq carpan (if (or (not ec) (= ec "Ekle")) 1.0 -1.0))
(setq hyazi (cdr (assoc 1 elist)))
(setq hyazi (distof (substr hyazi 1 (- (strlen hyazi) 3))))
(setq yazi (strcat (rtos (+ hyazi (* carpan alan)) 2 2) " mm²"))
(princ (strcat (rtos hyazi 2 2) " + " (rtos (* carpan alan) 2 2) " = " yazi))
(setvar "cmdecho" 0)
(command "undo" "m")
(setvar "cmdecho" 1)
(setq elist (subst (cons 1 yazi) (assoc 1 elist) elist))
(entmod elist)
(princ)
);defun
(defun c:ayy(/ yazi elist alan obje nokta al hedef son stylelist)
(setq stylelist (tblsearch "style" (getvar "TEXTSTYLE")))
(if (/= (cdr (assoc 40 stylelist)) 0.0)
(command "-STYLE" "" "" 0.0 "" "" "" "")
)
(setq obje (entsel "\nYazılacak alanı seçiniz :"))
(setq al (car obje) nokta (car (cdr obje)))

(command "AREA" "o" al)

(if al (setq alan (getvar "AREA")))
(princ (strcat " Alan = " (rtos alan 2 3) " mm²"))
; (setq yazi (strcat (rtos alan 2 2) " mm²"))
(setq yazi (strcat "%%U" (rtos alan 2 2) " mm²"))
; (setq yazi (strcat "%%U" (rtos alan 2 2)))
(setq hedef (car (entsel "\nHedef Yazıyı Seç <oluştur>:")))

(if hedef
(progn
(setq elist (entget hedef))
(setq elist (subst (cons 1 yazi) (assoc 1 elist) elist))
(entmod elist)
)
(progn
(setq _oldos_ (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq son (getpoint nokta))
(command "LEADER" nokta son "" "" "N")
(command "TEXT" son "" 0.0 yazi "")
(setvar "OSMODE" _oldos_)
)
);if
(princ)

28.04.2013 14:39    

thrcr
ilk lisp te unutma problemi olurken 2. lispte unutma problemi olmuyor.
İnşallah anlatabilmişimdir.

28.04.2013 15:04    

ehya
unutma problemi ne demek ya :)
autocad'in lispleri unutma gibi bir durumu söz konusu olamaz.
lispin hatalı yazımından dolayı döngüsel işlemlerde sıkıntısı vardır. Bu da lispin çalışmamasını sağlar.

Komutu yazdığınızda "Unknown command" yazması lispin yüklenmediğini yani böyle bir komutun olmadığını belirtir.
Ancak komutu çalıştırdığınızda hiçbir işlem yapmadan tekrar "Command" satırına dönmesi yukarıda bahsettiğim sorundan kaynaklanıyordur.

28.04.2013 15:29    

thrcr
ehya arkadaşım load yaptığımda çalışıyor fakat contents işlemi çalışmıyor diyeyim o zaman bunun çözümü yok mu
bu önemli benim için

> 1 <
Copyright © 2004-2022 SQL: 1.211 saniye - Sorgu: 70 - Ortalama: 0.0173 saniye