Lisp istekleri | Forumlar

AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim

aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A

Forumlar > AutoLISP > Lisp istekleri

82233

17.10.2015 10:31

halilozcakir

Alıntı
alumina :

evet aynen öyle komut gir değişecek renk numarasını gir yeni renk numarası gir gibi..

82236

17.10.2015 13:12

alumina

Alıntı
halilozcakir :

Kod:

(defun c:ly (/ o n ly) (vl-load-com)
(if (setq o (getint "\nOld number:"))
(if (setq n (getint "\nNew number:"))
(progn
(vlax-for ly (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object)))
(if (= (vla-get-Color ly) o) (vla-put-Color ly n)))
)
)
) (princ)
)

82328

02.11.2015 12:39

zahmeri

İyi günler sevgili arkadaşlar.Aşağıda yazılı olan lisp metraj çıkarırken line,poliline vb. çizimlerin uzunluklarını topluyor,ayrıca kaç adet seçim yapılmışsa adet bilgiside veriyor(Seçilen çizim 6,toplam uzunluk 10mt gibi).Bu lisbede yanlış hatırlamıyorsan bu site sayesinde ulaşmıştım.Gerçekten çok kullanışlı öncelikle bu paylaşım için teşekkür ederim.Yapandan paylaşandan Allah razı olsun.Bu lisple ilgili bir sıkıntım var şöyleki;uzunluk toplamak için komutu aktif ettiğimde toplam içine dahil ettiğim bir line yada poliline'ı aynı toplam içine ikinci kez dahil edemiyorum.Bu durum beni gerçek manada zor durumda bırakıyor.Bu sorunun çözüme kavuşturulması noktasında paylaşmış olduğum lispi geliştirirseniz inanın çok memnun olurum..
Kısayolu 'uo' ve 'metraj' olan iki farklı lisp daha indirdim kullandım fakat bahsettiğim sorun o iki farklı lisp içinde aynı şekilde devam etti..
Bu sorunu aynı site içerisinde farklı bir sayfada daha paylaşmıştım ama sanırım gözden kaçtı,çözüme ulaşamadım.İlgilenebilirseniz çok memnun olurum..
(defun C:UU()

(setvar "cmdecho" 0)

;;;--- Function to get the length of an ARC entity
(defun getArc(en)
(command "lengthen" en "")
(getvar "perimeter")
)

;;;--- Function to get the length of a LINE entity
(defun getLine(en)
(setq enlist(entget en))
(distance (cdr(assoc 10 enlist)) (cdr(assoc 11 enlist)))
)

;;;--- Function to get the length of a POLY, CIRCLE, SPLINE, OR ELLIPSE
(defun getPoly(en)
(command "area" "Object" en)
(getvar "perimeter")
)

;;;--- Main application

;;;--- Let the user select objects
(if(setq eset(ssget))
(progn

;;;--- Set up a variable to hold the length
(setq totalLen 0)

;;;--- Set up a counter
(setq cntr 0)

;;;--- Cycle through each entity in the selection set
(while(< cntr (sslength eset))

;;;--- Get the first entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes
(setq enlist(entget en))

;;;--- Get the type of entity
(setq enType(cdr(assoc 0 enlist)))

;;;--- Get the length based on entity type
(cond
((= enType "ARC" )(setq len(getArc en)))
((= enType "CIRCLE" )(setq len(getPoly en)))
((= enType "ELLIPSE" )(setq len(getPoly en)))
((= enType "LINE" )(setq len(getLine en)))
((= enType "LWPOLYLINE")(setq len(getPoly en)))
((= enType "POLYLINE" )(setq len(getPoly en)))
((= enType "SPLINE" )(setq len(getPoly en)))
(T (setq len 0.0))
)

;;;--- Format the entity type to be 12 characters long
(while(< (strlen enType) 12)(setq enType(strcat enType " ")))

;;;--- Inform the user of progress
(princ "\n Found ")
(princ enType)
(princ " with a length of: ")
(princ (rtos len))

;;;--- Total the length
(setq totalLen(+ totalLen len))

;;;--- Increment the counter to get the next entity
(setq cntr (+ cntr 1))
)
)
)

(setvar "cmdecho" 1)

;;;--- Inform the user of the results
(alert (strcat " obje sayisi= " (itoa cntr) " toplam uzunluk= " (rtos totalLen)))

;;;--- Suppress the last echo for a clean exit
(princ)
)

82329

02.11.2015 12:48

alumina

o line i toplama kac kez dahil etmek istiyorsaniz o kadar sayida yanina kopyalarsaniz zor durumda kalmazsınız herhalde.

82330

02.11.2015 13:33

zahmeri

Evet haklısınız Sn Alumina.Tavsiyeniz bir çözüm ve küçük projelerde bu dediğinizi yaptım ama,bir çizim içinde belki 10, belki 20 adet line veya poliline'ı aynı toplam içine 5-10 kez dahil etmek gerekiyor.Bu durumda bu line ları bir biri ile karıştırmadan toplam içine kaç kez dahil edileceğini not edip kopyalamak ve çizim bozmadan bu line ları toplamak dahil etmek ve sonrasında silmek bazen o kadar karışıyorki insan neyi yaptığını neyi yapmadığını birbirine karıştırıyor...

82331

02.11.2015 13:53

alumina

Sayin Zahmeri,
Bahsettiginiz sekilde bir toplamin yapilmasi soz konusu olamaz. Eger olabilseydi, bu seferde hangi cizgiyi kac defa sectiginizi anlayamazdiniz. O yuzden toplam alacaginiz zaman, yukarda bahsettigim kopyalama islemini calistigniz dosyanin bir kopyasi uzerinde yapmaniz daha dogru olacaktir.

82333

02.11.2015 17:48

onurkurnazkasso

Alıntı
ehya :
İstediğin lispi yöneticiye gönderdim. En kısa zamanda siteye ekler.
Kullanımda hata bulursanız, mutlaka bildirin. En kısa zamanda düzeltirim.

Lisp kodu aşağıdadır...
[Admin]

Kod:

(defun m2_br_sec ()
(if (= cizim_birim nil)
(progn
(initget 1 "Metre Cm")
(setq cizim_birim (getkword "
Çizim Birimini seçiniz [Metre / Cm]:")))))
(defun m2_stil ()
(setq m2_stil_ara (tblsearch "style" "m2"))
(if (= m2_stil_ara nil)
(progn
(setq m2_yaz_yuk 12)
(setq m2_yaz_y (getdist (strcat "
Yazı Yüksekliği:< " (rtos m2_yaz_yuk) ">:")))
(if (= m2_yaz_y nil)
(setq m2_yaz_y m2_yaz_yuk))
(setq m2_yaz_yuk m2_yaz_y)
(command "style" "m2" "arial.ttf" m2_yaz_yuk "0.8" "" "" ""))))
(defun c:m2 ()
(setvar "modemacro" "Archme Design 2005 ©")
(setvar "cmdecho" 0)
(m2_br_sec)
(if (= cizim_birim "Metre")
(setq m2_bol 100)
(setq m2_bol 10000))
(setq m2_secim (ssget '((-4 . "<OR")
(0 . "LWPOLYLINE")
(0 . "POLYLINE")
(0 . "CIRCLE")
(0 . "ELLIPSE")
(0 . "SPLINE")
(0 . "REGION")
(0 . "3DSOLID")
(-4 . "OR>"))))
(if (= m2_secim nil)
(progn
(princ))
(progn
(setq m2_secim_say (sslength m2_secim))
(setq m2_c 0)
(setq m2_toplam 0)
(while (< m2_c m2_secim_say)
(setq m2_secim_tek (ssname m2_secim m2_c))
(command "area" "e" m2_secim_tek)
(setq m2_tek_alan (/ (getvar "area") m2_bol))
(setq m2_toplam (+ m2_toplam m2_tek_alan))
(setq m2_c (+ m2_c 1)))
(m2_stil)
(setq m2_aciklama (getstring t "
Yazılacak metni yazınız:"))
(setq m2_yer (getpoint "
Yer Gösterin:"))
(if (= m2_yer nil)
(progn
(princ "
Yer gösterilmediği için komut bitirildi !!!..."))
(progn
(setvar "textstyle" "m2")
(command "text" m2_yer "0" m2_aciklama)
(command "text" "" (strcat (rtos m2_toplam 2 2) " m2"))
))))(princ))

Ehya hocam
Bir kare dusunun bunun icinde kesilecek sekiller var.
M2 hesabina bu sekillerin m2 sini duserek karenin m2 sini en hizli sekilde nasil yapariz veya bunu la ilgili bir lisp mevcutmudur

82334

02.11.2015 18:07

onurkurnazkasso

Umarim sorumu anlatabilmisimdir

82335

03.11.2015 06:52

ehya

Bu lisple olmaz o dedikleriniz...

82407

13.11.2015 17:57

defikol

Herkese merhaba,

Bana diyelim 10mx15m olan bir dikdörtgen var içinde de 2mx3m gibi bir diktörtgen olsun, bu büyük diktörtgenin alanı 150m2 küçük dirtgöneninde alanı 6m2 vede net alan 144m2 işte bana bu 144m2 lik alanı hesaplayan lisp lazım. Büyük alan içindeki küçük alanları çıkaran ve net alanı veren lisp. Bu benim işime çok yarayacak, yardımsever hocalarımdan cevap bekliyorum.

Bu forumdaki ilk isteğim yardımcı olabilen olursa çok işime yarayacak.Müteşekkir olurum.

Güncellerme ;;

İnternetten şöyle bir lisp buldum ama bulduğu net alanı komut satırına yazıyor. ama ben alanın içine yazsın istiyorum ve de yapılabiliyorsa metre cinsinden yazsın yapabilirmiyiz.

(Defun c:demo (/ el ss AreaForAll index ObjectArea)
(while
(and (setq AreaForAll nil
el (entlast)
ss (ssadd)
)
(setq
point1 (GETPOINT
"\nClique à l'intérieur de l'objet à mesurer : "
)
)
)
(command "-boundary" point1 "")
(while (setq el (entnext el))
(ssadd el SS)
)
(setq index 0)
(repeat (sslength ss)
(setq ObjectArea
(vlax-get (vlax-ename->vla-object (ssname ss index))
'Area
)
)
(setq AreaForAll (cons ObjectArea AreaForAll))
(setq index (1+ index))
)
(setq AreaForAll (vl-sort AreaForAll '>))
(command "_erase" ss "")
(princ (strcat "\Total Area: "
(rtos (abs (eval (cons - AreaForAll))) 2 4)
)
)
)
(princ)
)
(vl-load-com)

defikol (13.11.2015 20:41 GMT)

82411

17.11.2015 10:46

mikemoon

merhabalar

Seçilen nesnenin layer ını kapatan lisp forumda var yapan kişi süper yapmış birde kapalı tüm layırları açan bir lisp varmıdır.

82415

17.11.2015 14:06

Travaci

Kapatan ama ne ? Freeze mi yapıyor, off mu yapıyor, lock mu yapıyor ne yapıyor !

82417

17.11.2015 15:15

mikemoon

off yapması lazım

82418

17.11.2015 15:20

Travaci

Mayki şu Autocad'i araştır biraz gözünü seviyim. Toolbarlardan layer2 yi aktif et, bak bi hangi komutlar var.

82419

17.11.2015 15:26

mikemoon

araştırdım ve buldum

layer on off bölümü var thanks

82506

18.12.2015 08:54

volkan_25

; inserts increasing numbers
(defun c:nm (/ p n ni ts oecho ds th txt na)

(setq ts (getvar "textsize"))
(if (= 0 (getvar "dimscale"))(setq ds 1.0)(setq ds (getvar "dimscale")))
(setq th (getvar "dimtxt"))
(setq txt (* th ds))
(if nn (setq nn (fix nn))(setq nn 1))
(if (= nn 0)(setq nn 1))
(princ "\n Increment by < ")
(princ nn)
(princ " >? : ")
(setq ni (getint))
(if (= ni nil)(setq ni nn)(setq nn ni))

(if np
()
(setq np 1)
)
(princ "\n Start or continue with number < ")
(princ np)
(princ " >? : ")
(setq n (getint))
(if (= n nil)
(setq n np)
(setq np n)
)
(setq p (getpoint "\n Number location: "))
(setq oecho (getvar "cmdecho"))
(setvar "cmdecho" 0)

(while p
(setq na (itoa n))
(entmake (list (cons 0 "TEXT")
(cons 10 p)
(cons 11 p)
(cons 1 na); actual text
(cons 7 (getvar "TEXTSTYLE"))
(cons 40 txt)
(cons 72 4)
)
)
(setq p (getpoint "\n Next number location: ")
n (+ ni n)
np n
)
)

(setvar "cmdecho" oecho)
(princ)
)

(princ "\n Type > NM < to insert numbers.")

bu lisp çalışıyor isteğim yazı yüksekliğini ve rakam genişlik ayarını ben belrleyeyim yardımcı olursanız sevinirim.

82507

18.12.2015 10:02

Travaci

textsize komutu ile yazı yüksekliğini değiştirebilirsin.
(cons 41 0.8)
"0.8" = width factor value
Diğeri için ise bu kısmı ekleyin.

82508

18.12.2015 11:42

volkan_25

tşk ederim ama ben değişken yapabilmeliyim sabit değil

82509

18.12.2015 12:26

Travaci

Kod: