25.01.2023 06:53    

baha07
merhabalar
bu lisp olusturdugu dwgleri ``C:\Users\........\Documents\... `` icinde gosterdigim bir klasore kaydediyor .

secim klasorunu , klasor iletisim penceresiyle (pc nin herhangibir yerindeki klasoru) secmesi icin ;

yardimci olabilir misiniz

Kod:

; ----------------------------------------------------------------------
;          Bloklari , blok ismiyle tek tek dwg`lere ayirir
;          (Wblocks all local block definitions to target path)
;            Copyright (C) 2000 DotSoft, All Rights Reserved
;
; ----------------------------------------------------------------------
; DISCLAIMER:  DotSoft Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims.
; DotSoft makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose.  All materials are
; to be considered ‘as-is’, and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------
(defun c:wba ()
  (setq cmdecho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  ;
  (if (not dos_getdir)
    (setq path (getstring "\nDS> Target Folder: " T))
    (setq path (dos_getdir "Target Folder" (getvar "DWGPREFIX")))
  )
  (if (/= path nil)
    (progn
      (if (= (substr path (strlen path) 1) "")
        (setq path (substr path 1 (1- (strlen path))))
      )
      (princ "\nDS> Building List of Blocks ... ")
      (setq lst nil)
      (setq itm (tblnext "BLOCK" T))
      (while (/= itm nil)
        (setq nam (cdr (assoc 2 itm)))
        (setq pass T)
        (if (/= (cdr (assoc 1 itm)) nil)
          (setq pass nil)
          (progn
            (setq ctr 1)
            (repeat (strlen nam)
              (setq chk (substr nam ctr 1))
              (if (or (= chk "*")(= chk "|"))
                (setq pass nil)
              )
              (setq ctr (1+ ctr))
            )
          )
        )
        (if (= pass T)
          (setq lst (cons nam lst))
        )
        (setq itm (tblnext "BLOCK"))
      )
      (setq lst (acad_strlsort lst))
      (princ "Done.")
      ;
      (foreach blk lst
        (setq fn (strcat path (chr 92) blk))
        (if (findfile (strcat fn ".dwg"))
          (command "_.WBLOCK" fn "_Y" blk)
          (command "_.WBLOCK" fn blk)
        )
      )
    )
  )
  ;
  (setvar "CMDECHO" cmdecho)
  (princ)
)

baha07 (25.01.2023 07:37 GMT)

25.01.2023 07:42    

ehya
baha07




lispin üst kısmında yer alan bu bölümü sil.

(if (not dos_getdir)
(setq path (getstring "\nDS> Target Folder: " T))
(setq path (dos_getdir "Target Folder" (getvar "DWGPREFIX")))
)



Bunun yerine aşağıdaki satırı ekle.

Kod:

(defun LM:browseforfolder ( msg dir bit / err fld pth shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (vlax-get-property slf 'path)
                              pth (vl-string-right-trim "\" (vl-string-translate "/" "\" pth))
                        ))))))
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    ))
(setq path (LM:browseforfolder "Klasör seçin" nil 0))

25.01.2023 10:21    

baha07
kod icin tesekkurler ,,, malesef calismadi error: misplaced dot on input
hatasi verdi .
Kod:

; ----------------------------------------------------------------------
;          Bloklari , blok ismiyle tek tek dwg`lere ayirir
;          (Wblocks all local block definitions to target path)
;            Copyright (C) 2000 DotSoft, All Rights Reserved
;                duzenleyen : cizimokulu  Ehya
; ----------------------------------------------------------------------
; DISCLAIMER:  DotSoft Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims.
; DotSoft makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose.  All materials are
; to be considered ‘as-is’, and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------
(defun c:wba ()
  (setq cmdecho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  ;
  (defun LM:browseforfolder ( msg dir bit / err fld pth shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (vlax-get-property slf 'path)
                              pth (vl-string-right-trim "" (vl-string-translate "/" "" pth))
                        ))))))
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    ))
(setq path (LM:browseforfolder "Klasor secin" nil 0))
  (if (/= path nil)
    (progn
      (if (= (substr path (strlen path) 1) "")
        (setq path (substr path 1 (1- (strlen path))))
      )
      (princ "\nDS> Building List of Blocks ... ")
      (setq lst nil)
      (setq itm (tblnext "BLOCK" T))
      (while (/= itm nil)
        (setq nam (cdr (assoc 2 itm)))
        (setq pass T)
        (if (/= (cdr (assoc 1 itm)) nil)
          (setq pass nil)
          (progn
            (setq ctr 1)
            (repeat (strlen nam)
              (setq chk (substr nam ctr 1))
              (if (or (= chk "*")(= chk "|"))
                (setq pass nil)
              )
              (setq ctr (1+ ctr))
            )
          )
        )
        (if (= pass T)
          (setq lst (cons nam lst))
        )
        (setq itm (tblnext "BLOCK"))
      )
      (setq lst (acad_strlsort lst))
      (princ "Done.")
      ;
      (foreach blk lst
        (setq fn (strcat path (chr 92) blk))
        (if (findfile (strcat fn ".dwg"))
          (command "_.WBLOCK" fn "_Y" blk)
          (command "_.WBLOCK" fn blk)
        )
      )
    )
  )
  ;
  (setvar "CMDECHO" cmdecho)
  (princ)
)

baha07 (25.01.2023 11:25 GMT)

25.01.2023 10:44    

ehya
İlk paylaştığın kod ile son düzenlediğin kod arasında \ farkı vardı.. Ya yanlışlıkla koydun bunu. Ya da doğru yerde konumlandırılmamış.. Son mesajında bunu silerek düzenledim.. Kodu alıp tekrar denermisin?

25.01.2023 11:19    

baha07
Alıntı
ehya :
İlk paylaştığın kod ile son düzenlediğin kod arasında \ farkı vardı.. Ya yanlışlıkla koydun bunu. Ya da doğru yerde konumlandırılmamış.. Son mesajında bunu silerek düzenledim.. Kodu alıp tekrar denermisin?


Ehya bey ,
tesekkur ederim . kod problemsiz calisiyor .
````\ farki konusu ``` anlayamadigim bir sekilde degistirmisim

baha07 (25.01.2023 11:26 GMT)

26.01.2023 08:02    

upinarbasi
merhabalar,
noyaz komutunda ki gibi tıkladıkça detay-1, detay-2 detay-3 şeklide yazacak bir lispe ihitiyacım var.
isteklerde aşağıdaki gibi bir lisp buldum ama bunu çalıştırdığımda "detay-" gelmiyor.
bu konuda yardımcı olmanızı rica ederim.

(defun C:msa1 ()

(setq yazıyüksekliği (getdist (strcat "
Yazi Yuksekligini Giriniz : ")))
(setq metin (getstring "
metni yazınız : "))
(setq başsayı (getdist (strcat "
Başlangıç sayısını yazınız : ")))
(setq artım (getreal "
artım miktarını yazınız :"))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı))

(while (> 10000)
(setq başsayı (+ 1 başsayı))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı))
)
)

26.01.2023 09:05    

baha07
Alıntı
upinarbasi :
merhabalar,
noyaz komutunda ki gibi tıkladıkça detay-1, detay-2 detay-3 şeklide yazacak bir lispe ihitiyacım var.
isteklerde aşağıdaki gibi bir lisp buldum ama bunu çalıştırdığımda "detay-" gelmiyor.
bu konuda yardımcı olmanızı rica ederim.
(defun C:msa1 ()
(setq yazıyüksekliği (getdist (strcat "
Yazi Yuksekligini Giriniz : ")))
(setq metin (getstring "
metni yazınız : "))
(setq başsayı (getdist (strcat "
Başlangıç sayısını yazınız : ")))
(setq artım (getreal "
artım miktarını yazınız :"))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı))
(while (> 10000)
(setq başsayı (+ 1 başsayı))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı))
)
)




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


3- TXTYAZ_T ------------ txt dosyasina nokta ismiyle birlikte koordinatlari yazdirir( koor arasi bosluktur)
isin acilse , bu lisp senin istedigini yapiyor , eger tablo ve txt lazim degilse . isin bitince silersin

26.01.2023 11:02    

baha07
Alıntı
upinarbasi :
merhabalar,
noyaz komutunda ki gibi tıkladıkça detay-1, detay-2 detay-3 şeklide yazacak bir lispe ihitiyacım var.
isteklerde aşağıdaki gibi bir lisp buldum ama bunu çalıştırdığımda "detay-" gelmiyor.
bu konuda yardımcı olmanızı rica ederim.
(defun C:msa1 ()
(setq yazıyüksekliği (getdist (strcat "
Yazi Yuksekligini Giriniz : ")))
(setq metin (getstring "
metni yazınız : "))
(setq başsayı (getdist (strcat "
Başlangıç sayısını yazınız : ")))
(setq artım (getreal "
artım miktarını yazınız :"))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı))
(while (> 10000)
(setq başsayı (+ 1 başsayı))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı))
)
)




sizin yazdiginiz lisp cizim okulu noyaz lispinin uzerinden duzenlenme yapilmak icin baslanip yarim birakilmis



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



istediginiz yada yapmaya calistiginiz lisp assagidakidir

Kod:

(defun C:Noyaz ()

(setq yaziyuksekligi (getdist (strcat "
Yazi Yuksekligini Giriniz : ")))
(setq B (getstring "\nbaslik giriniz :"))
(setq NNO (getint "\nBaslama Numarasi Giriniz :"))
(setq koordinat (getpoint "
yazilacak yeri tiklayiniz :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yaziyuksekligi 2) koordinaty) 0))
(command "_text" koordinat yaziyuksekligi "0" (strcat B (rtos NNO 2 0)))

(while (> 10000)
(setq NNO (+ 1 NNO))
(setq koordinat (getpoint "
yazilacak yeri tiklayiniz :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yaziyuksekligi 2) koordinaty) 0))
(command "_text" koordinat yaziyuksekligi "0" (strcat B (rtos NNO 2 0)))
)
)

(PRINC " --> 'www.autocadokulu.com' Cizim yardimlari yuklendi Noyaz (LISPINDEN DUZENLENMISTIR)!")
(PRINC " Lispi calistirmak icin komut satirina 'Noyaz' yaziniz ")

27.01.2023 13:26    

umutdogan62
Merhaba arkadaşlar kolay gelsin. Sizden lisp rica edecektim. Ek'te gönderdiğim resimde kesit alanlarını hatch ile (solid) taradım. Her hatch tabakalarına ayırarak belirttim. Benim istediğim lisp tüm hatchleri seçtiğimde herhangi bir yere tıkladığımda tablo gibi veya resimdeki gibi layer ismi ve alanları metrekare olarak yazması. Tek tek özelliklerden bakıp alan yazmak çok zaman kaybettiriyor. .Sizden ricam bana yardımcı olursanız sevinirim. Şimdiden teşekkürler.
[img]https://cizimokulu.com/datas/users/397674-ekran-goruntusu-(21).png[/img]

umutdogan62 (27.01.2023 13:45 GMT)

27.01.2023 16:33    

alumina
Alıntı
umutdogan62 :

Secilen hatch nesnesinin properties penceresinde Area degeri gorunur olmalidir. Gorunmuyorsa o hatch nesnesi icin 'Area ozelligi desteklenmiyor demektir. Bu durumda program bu nesneyi dikkate almaz ve sonuc yaniltici olabilir. Farkli layerlerde farkli sayida hatch nesneleri olabilir. Program her layerdeki hatch nesnelerinin alanlarini kendi icinde toplayarak sonuclari gosterilen yere yazar. Yazi yuksekligini degistirmek icin (getvar 'TextSize) ifadesi yerine istediginiz degeri yazabilirsiniz.

Kod:

(defun c:qw (/ dc th ss px k ly lt n)
            (vl-load-com)
  (if (and (setq dc (vla-get-ActiveDocument
             (vlax-get-acad-object))
          th (getvar 'TextSize)
            ss (ssget '((0 . "Hatch"))))
        (setq px (getpoint "\nSpecify point:")))
    (progn
      (repeat (setq k (sslength ss))
        (setq k (1- k)
          ly (cdr (assoc 8 (entget (ssname ss k))))
            lt (if (not (member ly lt))
              (cons ly lt) lt)))
      (sssetfirst nil ss)
      (vla-StartUndomark dc)
      (foreach m lt
        (entmake (list '(0 . "Text") (cons 1 (strcat
          (rtos (apply '+ (mapcar '(lambda(a)
            (setq n (vlax-ename->vla-object a))
              (if (vlax-property-available-p n 'Area)
                (vla-get-Area n))) (vl-remove-if 'listp
                  (mapcar 'cadr (ssnamex (ssget "_I"
                    (list (cons 8 m)))))))) 2 3) " m2"))
          (cons 8 m) (cons 10 px) (cons 11 px) (cons 40 th)
            '(71 . 0) '(72 . 0) '(73 . 2)))
        (setq px (polar px (+ pi (/ pi 2.)) (* 2. th)))
      )
      (vla-EndUndomark dc)
      (sssetfirst nil nil)
    )
  ) (princ)
)

28.01.2023 04:40    

umutdogan62
Alıntı
alumina :
Alıntı
umutdogan62 :

Öncelikle cevapladığınız için teşekkür ederim. Alanları doğru veriyor rengine göre de ayırıyor. Elinize Sağlık. Buna tabaka ismini ekleyebilme imkanınız var mı? Mesela kırmızı renkli olan yarma tabakasında. tabaka ismi: alan m2 olarak yazarsa çok iyi olur. Birde yazıyı ekrana yazdırmadan önce yazı yüksekliğini sorsa daha iyi olur gibi.

alumina (28.01.2023 08:04 GMT)

28.01.2023 08:11    

alumina
Alıntı
umutdogan62 :

Kod:

(defun c:qw (/ dc ss th px k ly lt n)
            (vl-load-com)
  (if (and (setq dc (vla-get-ActiveDocument
             (vlax-get-acad-object))
          ss (ssget '((0 . "Hatch"))))
        (setq th (getreal "\nEnter the text size:"))
          (setq px (getpoint "\nSpecify point:")))
    (progn
      (repeat (setq k (sslength ss))
        (setq k (1- k)
          ly (cdr (assoc 8 (entget (ssname ss k))))
            lt (if (not (member ly lt))
              (cons ly lt) lt)))
      (sssetfirst nil ss)
      (vla-StartUndomark dc)
      (foreach m lt
        (entmake (list '(0 . "Text") (cons 1 (strcat
          m ": " (rtos (apply '+ (mapcar '(lambda(a)
            (setq n (vlax-ename->vla-object a))
              (if (vlax-property-available-p n 'Area)
                (vla-get-Area n))) (vl-remove-if 'listp
                  (mapcar 'cadr (ssnamex (ssget "_I"
                    (list (cons 8 m)))))))) 2 3) " m2"))
          (cons 8 m) (cons 10 px) (cons 11 px) (cons 40 th)
            '(71 . 0) '(72 . 0) '(73 . 2)))
        (setq px (polar px (+ pi (/ pi 2.)) (* 2. th)))
      )
      (vla-EndUndomark dc)
      (sssetfirst nil nil)
    )
  ) (princ)
)

28.01.2023 09:38    

umutdogan62
Alıntı
alumina :
Alıntı
umutdogan62 :



Emeğinize sağlık. Çok teşekkür ediyorum.

alumina (28.01.2023 12:34 GMT)

29.01.2023 21:26    

fakir52
Merhabalar.
Bu qw lispi alanları m2 değil de cm2 cinsinden veriyor. Bunu nasıl düzeltebiliriz?

30.01.2023 06:04    

umutdogan62
Alıntı
fakir52 :
Merhabalar.
Bu qw lispi alanları m2 değil de cm2 cinsinden veriyor. Bunu nasıl düzeltebiliriz?



Çizimin ölçeğine bağlı. Benim çizimde m2 veriyor m cinsinden çalıştığım için.

31.01.2023 09:05    

g-a-951753
Merhaba. Çizimde "text" elemanlardan seçtiklerimin önüne arc işaretini (arc length alındığında çıkan işaret) eklemek istiyorum. Bu konuda yardımcı olur musunuz?

31.01.2023 10:39    

alumina
Alıntı
g-a-951753 :


Secilen text nesnelerinin basina veya sonuna istenilen karakterleri ekler..

Kod:

(defun c:tx (/ dc tx sc sl)
            (vl-load-com)
  (if (and (setq dc (vla-get-ActiveDocument
             (vlax-get-acad-object)))
        (ssget ":L" '((0 . "*Text")))
          (/= (setq tx (getstring T
            "\nEnter the character(s):")) ""))
    (progn (initget 0 "p s")
      (if (not (setq sc (getkword "\n[Prefix/Suffix] <Prefix>:")))
        (setq sc "p"))
      (vla-StartUndomark dc)
      (vlax-for m (setq sl (vla-get-ActiveSelectionSet dc))
        (vla-put-TextString m
          (strcat (if (= sc "p") tx "")
            (vla-get-TextString m)
              (if (= sc "s") tx ""))))
      (vla-EndUndomark dc) (vla-Delete sl)
    )
  ) (prin1)
)

31.01.2023 12:37    

baha07
Alıntı
g-a-951753 :
Merhaba. Çizimde "text" elemanlardan seçtiklerimin önüne arc işaretini (arc length alındığında çıkan işaret) eklemek istiyorum. Bu konuda yardımcı olur musunuz?


merhaba
senin bahsettigin nesne , bir simge degilki , kucuk bir arc
fakat , sembollerde bulunan ` ᴖ ` , ` ᵔ ` U+1D16 ve U+1D54 numarali ogeler isini gorebilir

alumina bey`in gonderdigi lispi kullanarak ekleyebilirsin

01.02.2023 08:40    

kyufuk
Merhaba, küçük bi isteğim olacaktı kendim yapmaya çalıştım ama yapamadım. Bir ölçüyü seçtikten sonra o ölçüyü 0.104 ve 0.292 ile çarpıp ölçünün ortasından hem sağına hem soluna 2 şer tane xline atması . Örnek verecek olursam 100 ölçüsü düşünün 0.104 ile çarpıp 10.4 hemen ölçünün solundan bi tane xline atıcak 10.4 e sonra aynı ölçüyü tekrar 0.292 ile çarpıcak bu seferde 29,2 çıkıyor ama bu sefer 10.4 attığımız ölçüden 29,2 ötesine xline atıcak ve bu iki çizgiyi ölçünün ortasından diğer tarafa mirrorlıcak gibi düşenebiliriz. Örneğe ait bi resim paylaşıyorum Yardımlarınız için şimdiden teşekkürler.

kyufuk (01.02.2023 08:46 GMT)

01.02.2023 09:32    

baha07
Alıntı
kyufuk :
Merhaba, küçük bi isteğim olacaktı kendim yapmaya çalıştım ama yapamadım. Bir ölçüyü seçtikten sonra o ölçüyü 0.104 ve 0.292 ile çarpıp ölçünün ortasından hem sağına hem soluna 2 şer tane xline atması . Örnek verecek olursam 100 ölçüsü düşünün 0.104 ile çarpıp 10.4 hemen ölçünün solundan bi tane xline atıcak 10.4 e sonra aynı ölçüyü tekrar 0.292 ile çarpıcak bu seferde 29,2 çıkıyor ama bu sefer 10.4 attığımız ölçüden 29,2 ötesine xline atıcak ve bu iki çizgiyi ölçünün ortasından diğer tarafa mirrorlıcak gibi düşenebiliriz. Örneğe ait bi resim paylaşıyorum Yardımlarınız için şimdiden teşekkürler.




verdigin degerler her zaman sabit mi

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] [35] [40] [45] [50] [55] [60] [65] [70] [75] [80] [85] [90] [95] > 96 < [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.284 saniye - Sorgu: 110 - Ortalama: 0.01168 saniye