AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoLISP > Lisp istekleri
14.04.2023 06:42    
alisezgin
çok teşekkür ederim . Tam istediğim gibi olmuş

24.04.2023 07:30    
alisezgin
merhaba şeflerim , bir lisp isteğim olacak .

netten araştırıp bulabildiğim lisp aşağıda . Bun lispin amacına hizmet edebilmesi için şu şekilde ilave yapmanızı isteyeceğim ;

plinenın metrajını plinenin her iki ucunada yazdıracak ve metrajın başına ( "L:" değil ) proje üzerinde textler var bana seçtirdiği birini yazdıracak. örnek resim ;



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




(defun c:plu(/ akyuk akstla1b ayar oz p-uzunluk baz-nok y_d)
(prompt "
12/2005 © Ver 1.0 Polyline uzunluğu yazımı.")
(setvar "cmdecho" 0)
(setq akyuk (getvar "TEXTSIZE"))
(setq akstl (getvar "TEXTSTYLE"))
(setq a1b 1)


(while (/= a1b nil)
(setq a1b (car (entsel "
Polyline ı seçiniz: ")))
(if (/= a1b nil)
(progn
(setq ayar (entget a1b))
(setq oz (cdr (assoc 0 ayar)))
(if (= oz "LWPOLYLINE")
(progn
(redraw a1b 3)
(command "area" "o" a1b)
(setq p-uzunluk (getvar "perimeter"))
(setq baz-nok (cdr (assoc 10 ayar)))

(princ (strcat "
Uzunluk: " (rtos p-uzunluk)" dir."))

(setq yazi (strcat "L: " (rtos p-uzunluk)))

(command "text" baz-nok "" "" yazi)
(setq baz-nok nil)
(setq y_d 1)
(if (/= a1b nil)
(redraw a1b 4))
)
(princ (strcat "
Seçilen obje Polyline değil, " oz " dir."))
)
))
)
(princ "
İşlem bitti.")
(princ)
)


şimdiden teşekkür ederim

09.05.2023 05:36    
alisezgin
şeflerim , lisp konusunda yardımlarınızı bekliyorum.
şimdiden teşekkürler

18.05.2023 07:50    
baha07
Alıntı
alisezgin :
merhaba şeflerim , bir lisp isteğim olacak .
netten araştırıp bulabildiğim lisp aşağıda . Bun lispin amacına hizmet edebilmesi için şu şekilde ilave yapmanızı isteyeceğim ;
plinenın metrajını plinenin her iki ucunada yazdıracak ve metrajın başına ( "L:" değil ) proje üzerinde textler var bana seçtirdiği birini yazdıracak. örnek resim ;


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


(defun c:plu(/ akyuk akstla1b ayar oz p-uzunluk baz-nok y_d)
(prompt "
12/2005 © Ver 1.0 Polyline uzunluğu yazımı.")
(setvar "cmdecho" 0)
(setq akyuk (getvar "TEXTSIZE"))
(setq akstl (getvar "TEXTSTYLE"))
(setq a1b 1)
(while (/= a1b nil)
(setq a1b (car (entsel "
Polyline ı seçiniz: ")))
(if (/= a1b nil)
(progn
(setq ayar (entget a1b))
(setq oz (cdr (assoc 0 ayar)))
(if (= oz "LWPOLYLINE")
(progn
(redraw a1b 3)
(command "area" "o" a1b)
(setq p-uzunluk (getvar "perimeter"))
(setq baz-nok (cdr (assoc 10 ayar)))
(princ (strcat "
Uzunluk: " (rtos p-uzunluk)" dir."))
(setq yazi (strcat "L: " (rtos p-uzunluk)))
(command "text" baz-nok "" "" yazi)
(setq baz-nok nil)
(setq y_d 1)
(if (/= a1b nil)
(redraw a1b 4))
)
(princ (strcat "
Seçilen obje Polyline değil, " oz " dir."))
)
))
)
(princ "
İşlem bitti.")
(princ)
)
şimdiden teşekkür ederim



istedegin degil ama manuel on ek ekler

Kod:

(defun c:plu(/ akyuk akstla1b ayar oz p-uzunluk baz-nok y_d)
(prompt "
12/2005 © Ver 1.0 Polyline uzunlugu yazimi.")
(setvar "cmdecho" 0)
(setq akyuk (getvar "TEXTSIZE"))
(setq akstl (getvar "TEXTSTYLE"))
(setq a1b 1)

(setq baslik (getstring "\nBASLiK GiRiNiZ :"))

(while (/= a1b nil)
(setq a1b (car (entsel "
Polyline i seciniz: ")))
(if (/= a1b nil)
(progn
(setq ayar (entget a1b))
(setq oz (cdr (assoc 0 ayar)))
(if (= oz "LWPOLYLINE")
(progn
(redraw a1b 3)
(command "area" "o" a1b)
(setq p-uzunluk (getvar "perimeter"))
(setq baz-nok (cdr (assoc 10 ayar)))

(princ (strcat "
Uzunluk: " (rtos p-uzunluk)" dir."))

(setq yazi (strcat baslik " " (rtos p-uzunluk)))

(command "text" baz-nok "" "" yazi)
(setq baz-nok nil)
(setq y_d 1)
(if (/= a1b nil)
(redraw a1b 4))
)
(princ (strcat "
Secilen obje Polyline degil, " oz " dir."))
)
))
)
(princ "
Islem bitti.")
(princ)
)
26.05.2023 12:34    
alisezgin
teşekkürler saygı değer şeflerim.

26.05.2023 12:51    
alisezgin
proje çizim konusunda yeniyim , aklıma takılan bir husus var . ataşmanlar hazırlanırken plineleri üst üste çizilmiş . bunları toplu şekilde nasıl yön verebilirim . vertex atamak aklıma geldi ama ondada toplu atama yapamıyorum .
26.05.2023 14:44    
baha07
Alıntı
alisezgin :
proje çizim konusunda yeniyim , aklıma takılan bir husus var . ataşmanlar hazırlanırken plineleri üst üste çizilmiş . bunları toplu şekilde nasıl yön verebilirim . vertex atamak aklıma geldi ama ondada toplu atama yapamıyorum .



Alıntı
bunları toplu şekilde nasıl yön verebilirim


neden 35 cizgi ust usteyse 1 taneye dusurmuyorsunuz ?

baha07 (26.05.2023 15:09 GMT)

26.05.2023 15:20    
alisezgin
Alıntı
baha07 :
Alıntı
alisezgin :
proje çizim konusunda yeniyim , aklıma takılan bir husus var . ataşmanlar hazırlanırken plineleri üst üste çizilmiş . bunları toplu şekilde nasıl yön verebilirim . vertex atamak aklıma geldi ama ondada toplu atama yapamıyorum .



Alıntı
bunları toplu şekilde nasıl yön verebilirim

neden 35 cizgi ust usteyse 1 taneye dusurmuyorsunuz ?
bu 35 pline tek bir noktadan başlayıp saha tarafında farklı noktalara gidiyor. Resimde sadece başladığı noktayı paylaştım .

26.05.2023 15:54    
baha07
Alıntı
alisezgin :
Alıntı
baha07 :
Alıntı
alisezgin :
proje çizim konusunda yeniyim , aklıma takılan bir husus var . ataşmanlar hazırlanırken plineleri üst üste çizilmiş . bunları toplu şekilde nasıl yön verebilirim . vertex atamak aklıma geldi ama ondada toplu atama yapamıyorum .



Alıntı
bunları toplu şekilde nasıl yön verebilirim

neden 35 cizgi ust usteyse 1 taneye dusurmuyorsunuz ?
bu 35 pline tek bir noktadan başlayıp saha tarafında farklı noktalara gidiyor. Resimde sadece başladığı noktayı paylaştım .



belki isini gorur , multi vertex ekliyor

Kod:

(defun C:MPLEDIT (/ adoc endpar near newpt objs sf ss util)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
util (vla-get-utility adoc)
  )
  (vla-startundomark adoc)
  (command "_ucs" "_W")
  (setq ss (ssget))
  (setq objs (mapcar 'vlax-ename->vla-object
       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      )
  )
  (setq newpt (getpoint "\nPick a new vertex location: "))
  ;;/*; thanks to Peter Jamtgaard

  (foreach obj objs
    (setq near (vlax-curve-getclosestpointto obj newpt))
    (if (> (length near) 2.0)
      (setq near (reverse (cdr (reverse near))))
    )
    (setq endpar (+ 1.0 (float (fix (vlax-curve-getparamatpoint obj near)))))

    (vlax-invoke obj 'addvertex endpar (reverse (cdr (reverse newpt))))
    ;;*/;

    (vla-createtypedarray util 'sf vlax-vbdouble (car newpt) (cadr newpt))
    (setq sf (vlax-make-variant sf))
    (vla-put-coordinate obj (fix endpar) sf)
  )
  (command "_ucs" "_P")
  (vla-endundomark adoc)
  (princ)
)
(vl-load-com)
(princ)
26.05.2023 16:23    
alisezgin
Alıntı
baha07 :
Alıntı
alisezgin :
Alıntı
baha07 :
Alıntı
alisezgin :
proje çizim konusunda yeniyim , aklıma takılan bir husus var . ataşmanlar hazırlanırken plineleri üst üste çizilmiş . bunları toplu şekilde nasıl yön verebilirim . vertex atamak aklıma geldi ama ondada toplu atama yapamıyorum .



Alıntı
bunları toplu şekilde nasıl yön verebilirim

neden 35 cizgi ust usteyse 1 taneye dusurmuyorsunuz ?
bu 35 pline tek bir noktadan başlayıp saha tarafında farklı noktalara gidiyor. Resimde sadece başladığı noktayı paylaştım .

belki isini gorur , multi vertex ekliyor
Kod:

(defun C:MPLEDIT (/ adoc endpar near newpt objs sf ss util)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
util (vla-get-utility adoc)
  )
  (vla-startundomark adoc)
  (command "_ucs" "_W")
  (setq ss (ssget))
  (setq objs (mapcar 'vlax-ename->vla-object
       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      )
  )
  (setq newpt (getpoint "\nPick a new vertex location: "))
  ;;/*; thanks to Peter Jamtgaard
  (foreach obj objs
    (setq near (vlax-curve-getclosestpointto obj newpt))
    (if (> (length near) 2.0)
      (setq near (reverse (cdr (reverse near))))
    )
    (setq endpar (+ 1.0 (float (fix (vlax-curve-getparamatpoint obj near)))))
    (vlax-invoke obj 'addvertex endpar (reverse (cdr (reverse newpt))))
    ;;*/;
    (vla-createtypedarray util 'sf vlax-vbdouble (car newpt) (cadr newpt))
    (setq sf (vlax-make-variant sf))
    (vla-put-coordinate obj (fix endpar) sf)
  )
  (command "_ucs" "_P")
  (vla-endundomark adoc)
  (princ)
)
(vl-load-com)
(princ)






Hocam çok teşekkür ederim

05.06.2023 13:27    
alisezgin

şeflerim araştırmalarım sonucu aradığım lispi veya kendi komutu varmı bulamadım .
istediğim lispin çalışma prensibi ; benim seçmiş olduğum birden fazla ve farklı blokların referans noktalarına bana çakılacak olan bloğun ismini soracak o bloğu çekip referans noktalarına çakacak.
örnek resim1 - projemizdeki blockların genel görünüşü .
örnek resim2 - seçimi yapılan blokların gösterimi .
örnek resim3 - komut çalıştıktan sonraki istenen durum .
yardımlarınız için şimdiden teşekkür ederim

alisezgin (05.06.2023 14:08 GMT)

05.06.2023 14:13    
baha07
Alıntı
alisezgin :

şeflerim araştırmalarım sonucu aradığım lispi veya kendi komutu varmı bulamadım .
istediğim lispin çalışma prensibi ; benim seçmiş olduğum birden fazla ve farklı blokların referans noktalarına bana çakılacak olan bloğun ismini soracak o bloğu çekip referans noktalarına çakacak.
örnek resim1 - projemizdeki blockların genel görünüşü .
örnek resim2 - seçimi yapılan blokların gösterimi .
örnek resim3 - komut çalıştıktan sonraki istenen durum .
yardımlarınız için şimdiden teşekkür ederim




https://cizimokulu.com/t18535-harita-harita-mesleki-lispler.html

2 numarali lisp var . biraz farkli calisma prensibi . uygulama noktalarina kendin kopyalayacaksin . lispi calistirdiginda blogun icine nesneyi ekleyebilirsin (1 eklenecek nesne - 2 blok )

06.06.2023 06:00    
ehya
alisezgin



Autocad 2024'de BREPLACE komutu ile bu işlemi gerçekleştirebilirsiniz.

06.06.2023 06:46    
alisezgin
Alıntı
ehya :
alisezgin

Autocad 2024'de BREPLACE komutu ile bu işlemi gerçekleştirebilirsiniz.

ilginiz için teşekkürler . aslında tam olarak isteğime hitap etmiyor . bu komut eski bloğun tamamı yerine yenisini yerleştiriyor. benim isteğim kendi seçtiğim blokların tamamına değil seçili olanlara atama yapmak . var mı bu tarz bir komut

06.06.2023 06:53    
ehya
Alıntı
alisezgin :
Alıntı
ehya :
alisezgin

Autocad 2024'de BREPLACE komutu ile bu işlemi gerçekleştirebilirsiniz.

ilginiz için teşekkürler . aslında tam olarak isteğime hitap etmiyor . bu komut eski bloğun tamamı yerine yenisini yerleştiriyor. benim isteğim kendi seçtiğim blokların tamamına değil seçili olanlara atama yapmak . var mı bu tarz bir komut




Yanlışınız var. Bu komut sadece seçilen blokların yerine istenilen bloğu koyar. Tamamına değil.

Sizin bahsettiğniz BLOCKREPLACE komutudur.. BREPLACE komutu ise 2014 ile birlikte geldi.

06.06.2023 09:57    
alumina
Alıntı
alisezgin :

baha07'nin sagdan soldan bulduklari kadar olmasada.... :))

Kod:

(defun c:qw (/ dc ns bn z)
            (vl-load-com)
  (if (and (setq dc (vla-get-ActiveDocument
             (vlax-get-acad-object))
          ns (ssget '((0 . "Insert"))))
        (setq bn (getstring "\nEnter the block name:")))
    (if (not (tblobjname "Block" bn))
      (alert (strcat """ bn "" not found"))
      (progn (vla-StartUndomark dc)
        (repeat (setq z (sslength ns))
          (setq z (1- z))
          (entmake (list '(0 . "Insert") (cons 2 bn)
            (assoc 10 (entget (ssname ns z))) '(41 . 1.)
              '(42 . 1.) '(43 . 1.) '(50 . 0.))))
        (vla-EndUndomark dc)
      )
    )
  ) (prin1)
)
06.06.2023 11:43    
alisezgin
Alıntı
alumina :
Alıntı
alisezgin :

baha07'nin sagdan soldan bulduklari kadar olmasada.... :))
Kod:

(defun c:qw (/ dc ns bn z)
            (vl-load-com)
  (if (and (setq dc (vla-get-ActiveDocument
             (vlax-get-acad-object))
          ns (ssget '((0 . "Insert"))))
        (setq bn (getstring "\nEnter the block name:")))
    (if (not (tblobjname "Block" bn))
      (alert (strcat """ bn "" not found"))
      (progn (vla-StartUndomark dc)
        (repeat (setq z (sslength ns))
          (setq z (1- z))
          (entmake (list '(0 . "Insert") (cons 2 bn)
            (assoc 10 (entget (ssname ns z))) '(41 . 1.)
              '(42 . 1.) '(43 . 1.) '(50 . 0.))))
        (vla-EndUndomark dc)
      )
    )
  ) (prin1)
)



baha07 ye laf yok :)) . her sorumda ilgileniyor sağolsun .
Aradığım lisp tam olarak buydu size teşekkür ederim .
Ayrıca site kurucularından allah razı olsun , takıldığımız noktalarda çözüm buluyorlar .

06.06.2023 12:05    
baha07
Alıntı
alumina :
Alıntı
alisezgin :

baha07'nin sagdan soldan bulduklari kadar olmasada.... :))
Kod:

(defun c:qw (/ dc ns bn z)
            (vl-load-com)
  (if (and (setq dc (vla-get-ActiveDocument
             (vlax-get-acad-object))
          ns (ssget '((0 . "Insert"))))
        (setq bn (getstring "\nEnter the block name:")))
    (if (not (tblobjname "Block" bn))
      (alert (strcat """ bn "" not found"))
      (progn (vla-StartUndomark dc)
        (repeat (setq z (sslength ns))
          (setq z (1- z))
          (entmake (list '(0 . "Insert") (cons 2 bn)
            (assoc 10 (entget (ssname ns z))) '(41 . 1.)
              '(42 . 1.) '(43 . 1.) '(50 . 0.))))
        (vla-EndUndomark dc)
      )
    )
  ) (prin1)
)



beni mi andin ))

o zaman bu islemde blok isimleri duzensizse , projeyi hizlandirmak icin .... hizli blok ismi degisikligi

Kod:

;**********************************
;          Rename block name
;    (block isminin degistirilmesi)
;
;        powered by yazgunesi                 
;       
;
; *********************************


(defun c:rbk (/ blksecimi blkname blknew)

; select block to view name
(setq blksecimi (entget(car(entsel "Select block to view NAMES : ")))
      blkname (cdr(assoc 2 blksecimi)) )
(princ (strcat ">>> " (cdr (assoc 2 blksecimi)) " <<<" )) ; princ block name
(setq blknew (getstring t "\nEnter new block name: "))
(command "_.rename" "_block" blkname blknew)
(prompt "\nBlock ismi basariyla degistirilmistir...")
(princ)
)
14.06.2023 11:34    
alisezgin


şeflerim yine ben , yine bir lisp isteği :
elimdeki lisp plinelerin metrajlarını yazıyor (tek tek seçim yapmam gerekiyor) ama ben aynı anda birden fazla pline seçip tek komutla tamamının bu şekilde yazılmasını istiyorum.
yardımcı olursanız sevinirim
(defun c:plu(/ akyuk akstla1b ayar oz p-uzunluk baz-nok y_d)
(prompt "
12/2005 © Ver 1.0 Polyline uzunluğu yazımı.")
(setvar "cmdecho" 0)
(setq akyuk (getvar "TEXTSIZE"))
(setq akstl (getvar "TEXTSTYLE"))
(setq a1b 1)
(while (/= a1b nil)
(setq a1b (car (entsel "
Polyline ı seçiniz: ")))
(if (/= a1b nil)
(progn
(setq ayar (entget a1b))
(setq oz (cdr (assoc 0 ayar)))
(if (= oz "LWPOLYLINE")
(progn
(redraw a1b 3)
(command "area" "o" a1b)
(setq p-uzunluk (getvar "perimeter"))
(setq baz-nok (cdr (assoc 10 ayar)))
(princ (strcat "
Uzunluk: " (rtos p-uzunluk)" dir."))
(setq yazi (strcat "L: " (rtos p-uzunluk)))
(command "text" baz-nok "" "" yazi)
(setq baz-nok nil)
(setq y_d 1)
(if (/= a1b nil)
(redraw a1b 4))
)
(princ (strcat "
Seçilen obje Polyline değil, " oz " dir."))
)
))
)
(princ "
İşlem bitti.")
(princ)
)

14.06.2023 12:57    
baha07
Alıntı
alisezgin :


şeflerim yine ben , yine bir lisp isteği :
elimdeki lisp plinelerin metrajlarını yazıyor (tek tek seçim yapmam gerekiyor) ama ben aynı anda birden fazla pline seçip tek komutla tamamının bu şekilde yazılmasını istiyorum.
yardımcı olursanız sevinirim
(defun c:plu(/ akyuk akstla1b ayar oz p-uzunluk baz-nok y_d)
(prompt "
12/2005 © Ver 1.0 Polyline uzunluğu yazımı.")
(setvar "cmdecho" 0)
(setq akyuk (getvar "TEXTSIZE"))
(setq akstl (getvar "TEXTSTYLE"))
(setq a1b 1)
(while (/= a1b nil)
(setq a1b (car (entsel "
Polyline ı seçiniz: ")))
(if (/= a1b nil)
(progn
(setq ayar (entget a1b))
(setq oz (cdr (assoc 0 ayar)))
(if (= oz "LWPOLYLINE")
(progn
(redraw a1b 3)
(command "area" "o" a1b)
(setq p-uzunluk (getvar "perimeter"))
(setq baz-nok (cdr (assoc 10 ayar)))
(princ (strcat "
Uzunluk: " (rtos p-uzunluk)" dir."))
(setq yazi (strcat "L: " (rtos p-uzunluk)))
(command "text" baz-nok "" "" yazi)
(setq baz-nok nil)
(setq y_d 1)
(if (/= a1b nil)
(redraw a1b 4))
)
(princ (strcat "
Seçilen obje Polyline değil, " oz " dir."))
)
))
)
(princ "
İşlem bitti.")
(princ)
)


Text hattin basina degilde ortasina istersen , haziri var

https://cizimokulu.com/forums.php?m=posts&p=90141#90141

Ö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] > 98 < [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.923 saniye - Sorgu: 104 - Ortalama: 0.0185 saniye