14.10.2015 11:31    

alumina
Ayni isimde baska bir blok varsa uyari vermesi daha mi iyi olurdu?

Kod:

(defun c:bn (/ ss nn bn) (vl-load-com)
  (if (setq ss (ssget ":s" '((0 . "insert"))))
    (progn
      (prompt (strcat "\nOld name: " (setq bn (vla-get-name
        (vlax-ename->vla-object (ssname ss 0))))))
      (if (/= (setq nn (getstring T "\nNew name:")) "")
        (progn
          (if (/= (tblobjname "block" nn) nil)
            (alert (strcat """ nn """ " is already in use"))
            (vla-put-name (vla-item (vla-get-blocks (vla-get-activedocument
              (vlax-get-acad-object))) bn) nn))
        )
      )
    )
  )
  (princ)
)

14.10.2015 11:39    

zahmeri
Hımmm...aslında hatadan kastım komutun uyarı vermesiydi.senin yaptığınıda denedim.ekrana uyarı tabelası çıkıyor.Beni yazdığımda imlecin altında ERROR tarzı bildirim var..Kullanım olarak seninki daha hoş.Yalnız ikisindede bir sorun var,aynı isimde blok ismi verildiğinde ve entere basıldığında komuttan çıkıyor.uyarı mesajından sonra enter e basınca komuta devam etse sanki çok daha iyi olur :)

14.10.2015 12:49    

Travaci
alumina


Olmaz :D

14.10.2015 13:05    

alumina
Alıntı
zahmeri :
Hımmm...aslında hatadan kastım komutun uyarı vermesiydi.senin yaptığınıda denedim.ekrana uyarı tabelası çıkıyor.Beni yazdığımda imlecin altında ERROR tarzı bildirim var..Kullanım olarak seninki daha hoş.Yalnız ikisindede bir sorun var,aynı isimde blok ismi verildiğinde ve entere basıldığında komuttan çıkıyor.uyarı mesajından sonra enter e basınca komuta devam etse sanki çok daha iyi olur :)



bak bakalim buradaki UYARI TABELASI nasil :)
Komut adi: bn

https://cizimokulu.com/datas/users/333661-bn.rar

19.10.2015 08:04    

zahmeri
Saygıdeğer arkadaşlar,aşağıda detayını yazdığım bir lisp var elimde.Metraj çıkarmak için gayet kullanışlı.Bir eksiği var sadece buda aslında ciddi bir sorun benim için şöyleki ; her line veya poliline olan çizgiler sadece bir kez seçilebiliyor.halbuki aynı olan bir line veya poliline çizgiyi toplam içine birden fazla dahil etmek gerekebiliyor..yazdığım bu lispte bahsettiğim sorunun çözümüne yardımcı olursanız gerçekten ç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)
)

19.10.2015 08:40    

ehya
zahmeri



bu lispin amacı, seçilen nesnelerin toplam uzunluğunu bulmak ise, aşağıdaki lispi kullanabilirsin.



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

19.10.2015 09:06    

zahmeri
Sn ehya,
Evet söylediğiniz gibi seçilen nesnelerin toplam uzunluğunu veriyor.Ayrıca kaç nesne seçildiği bilgiside veriyor.paylaştığınız lispide indirip kullandım.Hemen hemen aynı görevi yapıyor.Benim paylaştığımda hem seçilen adet bilgisi hem seçilenlerin toplam uzunluğunu,sizin yazdığınızda sadece seçilenlerin toplam uzunluğunu gösteriyor...Ama muzdarip olduğum sorunun çözümü noktasında faydalanamadım.Benim sorunum benim paylaştığım lisp üzerinde değişiklikler yapılarak line veya poliline olan veya uzunluk ölçmek için ne seçilmişse aynı toplam içine o çizgi veya şekli birden çok dahil ettirmek.Benim paylaştığımda da sizin paylaştığınızdada aynı toplam içine bir line veya poliline sadece birkez dahil edilebiliyor..Umarım derdimi anlatabilmişimdir..İnşallah dermanıda siz saygıdeğer arkadaşlarda vardır..

22.10.2015 06:29    

CAN123
Arkadaşlar günaydın,

aşağıdaki lispte yazılacak yazıyı mausun ucunda nasıl gösterebiliriz? Yani yazıyı yazacağımız noktayı seçmeden yazının ekranda belirmesini istiyorum.

teşekkürler

(defun c:TEST ()
(command "._layer" "_M" "M" "color" "7" "" "ltype" "continuous" "" "")
(Setvar "osmode" 4)
(setq p1 (getpoint "\n ilk nokta"))
(setq p2 (getpoint P1 "\n ikinci nokta"))
(setq DIM (Distance P1 P2))
(setq text (strcat "C/C:" (rtos DIM 2 0)))
(setq AC (Angtos (angle P1 P2)))
(command "style" "SIMPLEX" "" "" "" "" "" "" "")
(command "OSMODE" 0)
(setq p3 (getpoint "\n nokta"))
(command "text" "j" "tc" p3 AC text)
(princ)
)

22.10.2015 08:36    

Travaci
Can bunla seni kandırabilirmiyim :D

Kod:

(defun c:wam (/)
  (if (setq n1 (getpoint "\nFirst point:"))
    (if (setq n2 (getpoint n1 "\nSecond point:"))
      (command "_.text" (cadr (grread t 15 0))
        (getvar "textsize") (angtos (angle n1 n2)) (rtos (distance n1 n2) 2 0)
               "_.move" "L" "" (cadr (grread t 15 0))
      )
    )
  ) (princ)
)

22.10.2015 08:42    

CAN123
hayır:)

22.10.2015 08:53    

Travaci
CAN123


Ozaman vla-transformby ı araştır bakalım :D

22.10.2015 09:07    

CAN123
Tamamdir, sağolasın.

26.10.2015 11:26    

CAN123
Arkadaşlar merhaba,

Aşağıdaki yapmaya çalıştığım pozlandırma lispinde daire içerisinde kalan leader'i nasıl trimlayabilirim?
inters ile yapamadım.

(defun c:SDX ()
(setvar "cmdecho" 0) (command "_.undo" "group")
(setq oldlayer (getvar "CLAYER"))
(setq text (getint "\n Enter pos number :"))
(setq QL1 ( getpoint "\n Start Point : "))
(setq QL2 ( getpoint "\nsecond a Point : "))
(setq p1 ( getpoint "\nChoose a Point : "))
(command-S "._layer" "_M" "P" "color" "1" "" "ltype" "continuous" "" "")
(command "_qleader" QL1 QL2 p1 ^C )
(command-S "circle" p1 80 "")
(command-S "STYLE" "ARIAL_NARROW" "ARIAL NARROW" "60" "1" "0" "" "" "")
(setvar "CECOLOR" "3")
(command-S "text" "j" "mc" p1 0 text)
(setvar "CECOLOR" "bylayer")
(setvar "CLAYER" oldlayer)
(princ)
)

26.10.2015 12:42    

alumina
Inters'le cizgi ve dairenin kesisimini mi bulmaya calistin? Cevabin evetse, inters komutunu tekrar arastir. Eger inters'le olamayacagini anlarsan bu sefer vla-intersectwith komutunu arastir. Onunla kesin olur :)

26.10.2015 13:03    

CAN123
alumina hocam cevabınız için teşekkürler.

27.10.2015 13:12    

CAN123
Arkadaşlar merhaba,

Aşağıda yazmaya çalıştığım lisple ilgili iki sorum olacak.
Birincisi profili düz bi şekilde atınca problem olmuyor ancak eğimli atınca istediğim gibi olmuyor.

İkincisi ise programın sonunda blokları insert ederken BLT ile girilen değere göre blok ekletmeyi yapamıyorum. Daha iyi açıklamak gerekirse BLT=12 ise BLK12'yİ insert etsin, BLT=16 ise BLK16'yi insert etsin istiyorum. Şu an sadece BLK16'yı insert ediyor.

teşekkür ederim
Kod:

(Defun C:test (/ PRF THK BAS_NOK BIT_NOK L1 L2 ANG)
  (Setq osmode (getvar "osmode"))
  (Setq PRF (Getint "\n Oluşturmak istediğiniz profili giriniz  "))
  (Setq THK (Getint "\n Profil kalınlığını giriniz:  "))
  (Setq AXIS (Getint "\n Profil eksenini giriniz:  "))
  (Setq BLT (Getint "\n civata tipini giriniz:  "))
  (Setq km (cond ((= blt 12) 20)
((= blt 16) 25)
((= blt 20) 30)))
  (Setq BAS_NOK (getpoint "\n başlangıç noktasını seçiniz:"))
  (Setq BIT_NOK (getpoint bas_nok "\n bitiş noktasını seçiniz:"))
  (command "clayer" "e")
  (command "_line" BAS_NOK BIT_NOK "")
  (Setq ANG (Angle BAS_NOK BIT_NOK))

  (Setq B1 (POLAR BAS_NOK ANG (- km (* 2 km)))
B2 (POLAR BIT_NOK ANG km)
        L1 (Polar B1 (Angtof "90") AXIS)
L2 (Polar B2 (Angtof "90") AXIS)
L3 (Polar B1 (Angtof "270") (- PRF AXIS))
L4 (Polar B2 (Angtof "270") (- PRF AXIS))
L5 (Polar B1 (Angtof "90") (- AXIS THK))
L6 (Polar B2 (Angtof "90") (- AXIS THK))
)
  (command "clayer" "K")
  (command "_line" L1 L2 "")
  (command "_line" L3 L4 "")
  (command "_line" L5 L6 "")
  (command "_line" L1 L3 "")
  (command "_line" L2 L4 "")

  (command "insert" "blk16" BAS_NOK "" "" "")
  (command "insert" "blk16" BIT_NOK "" "" "")
  (princ)
  )

28.10.2015 06:47    

CAN123
Arkadaşlar merhaba,

Birinci sorunu hallettim. ikinci soru hakkında ne yapabilirim.

teşekkürler

Kod:

(Defun C:test (/ PRF THK AXIS BLT KM BAS_NOK BIT_NOK ANG L1 L2 L3 L4 L5 L6)
  (Setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (Setq PRF (Getint "\n Oluşturmak istediğiniz profili giriniz  "))
  (Setq THK (Getint "\n Profil kalınlığını giriniz:  "))
  (Setq AXIS (Getint "\n Profil eksenini giriniz:  "))
  (Setq BLT (Getint "\n civata tipini giriniz:  "))
  (Setq KM (cond ((= blt 12) 20)
((= blt 16) 25)
((= blt 20) 30)))
  (Setq BAS_NOK (getpoint "\n başlangıç noktasını seçiniz:"))
  (Setq BIT_NOK (getpoint bas_nok "\n bitiş noktasını seçiniz:"))
  (command "clayer" "e")
  (command "_Pline" BAS_NOK BIT_NOK "")
  (Setq ANG (Angle BAS_NOK BIT_NOK))
  (setq AC (Angtos (angle BAS_NOK BIT_NOK)))

  (Setq B1 (POLAR BAS_NOK ANG (- KM (* 2 km)))
B2 (POLAR BIT_NOK ANG KM)
        L1 (Polar B1 (+ ang (angtof "90")) AXIS)
L2 (Polar B2 (+ ang (angtof "90")) AXIS)
L3 (Polar B1 (+ ang (angtof "-90")) (- PRF AXIS))
L4 (Polar B2 (+ ang (angtof "-90")) (- PRF AXIS))
L5 (Polar B1 (+ ang (angtof "90")) (- AXIS THK))
L6 (Polar B2 (+ ang (angtof "90")) (- AXIS THK))
)
  (command "clayer" "K")
  (command "_line" L1 L2 "")
  (command "_line" L3 L4 "")
  (command "_line" L5 L6 "")
  (command "_line" L1 L3 "")
  (command "_line" L2 L4 "")
  (command "_circle" BAS_NOK (/ (* blt 1.5) 2) "")
  (command "_circle" BIT_NOK (/ (* blt 1.5) 2) "")
     
  (command "insert" "blk16"  BAS_NOK "" "" "")
  (command "insert" "blk16"   BIT_NOK "" "" "")

  (setvar "osmode" osm)
  (princ)
  )

28.10.2015 07:01    

Travaci
Can bunu yaparsın yauf sen ;)
blt değerin tam sayı olduğu için önce onu string e çeviriyorsun
(rtos blt_değeri 2 0) şimdi de diğer string imiz ile birleştiriyoruz
(setq cağırılacak_block_ismi (strcat "blk" (rtos blt_değeri 2 0)))

28.10.2015 07:12    

CAN123
Cevap için teşekkürler

03.11.2015 11:06    

CAN123
Arkadaşlar merhaba,
Belirleyeceğim 3 nokta etrafına istediğim uzaklıkta çizgi çizdirmeye çalışıyorum.

A Detayında P1 ve P2 noktaları dikken program doğru çalışıyor. Ancak B detayında olduğu gibi bu noktalar eğimli olduğu zaman doğru bir şekilde çalışmıyor ve 30 olmasını istediğim ölçüyü farklı veriyor. Sanırım X1 X2 X3 değerlerini alırken hata yapıyorum. Yardımcı olabilirmisiniz.

Kod:

(defun c:PLL ()
  (SETVAR "OSMODE" 4)
  (SETVAR "CLAYER" "ML")
  (SETQ P1 (GETPOINT "\n Birinci noktayı seçiniz...: ")
P2 (GETPOINT "\n İkinci noktayı seçiniz....: ")
P3 (GETPOINT "\n Üçüncü noktayı seçiniz....: ")
D1 (GETREAL "\n Kenara mesafeyi giriniz....: ")
)
  (SETQ ANG (ANGLE P1 P2))
  (SETQ X1 (CAR P1)
X2 (CAR P3)
X3 (- X2 X1))

  (SETQ B1 (POLAR P1 ANG (- D1 (* 2 D1) )))
  (SETQ B2 (POLAR P2 ANG D1))
  (SETQ B3 (POLAR P3 (+ ANG (ANGTOF "-90")) D1))
  (SETQ L1 (POLAR B1 (+ ANG (ANGTOF "-90")) (- D1 (* D1 2))))
  (SETQ L2 (POLAR B2 (+ ANG (ANGTOF "90")) D1))
  (SETQ L3 (POLAR B2 (+ ANG (ANGTOF "-90")) (+ X3 D1)))
  (SETQ L4 (POLAR B1 (+ ANG (ANGTOF "-90")) (+ X3 D1)))
 
  (COMMAND "Pline" L1 L2 L3 L4 L1 "")
 
  (PRINC)
  )



Copyright © 2004-2022 SQL: 2.09 saniye - Sorgu: 101 - Ortalama: 0.0207 saniye