Reklam

* E Posta Adresiniz:
* Kodu Girin:

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] > 35 < [39] Sonraki Sayfa
İleti Yazar
06.01.2015 19:24
80041    
alumina

[70] Editör

Online Durumu

599 ileti
Insaat Muhendisi
Istanbul

Kod:

(defun c:alm (/ *error* ob r oc vob obn i voc ocn nob) (vl-load-com)
(defun *error* (er) (if ob (redraw (ssname ob 0) 4)) (setq *error* nil))
(prompt "\nSelect block:")
(setq ob (ssget ":s" '((0 . "insert"))))
(redraw (ssname ob 0) 3)
(initget 7)
(setq r (getreal "\nEnter the hole diameter:"))
(prompt "\nSelect circles:")
(setq oc (ssget (list (cons 0 "circle") (cons 40 (/ r 2)))))
(redraw (ssname ob 0) 4)
(vl-cmdf "._undo" "be")
(setq vob (vlax-ename->vla-object (ssname ob 0)) obn (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint vob))) i -1)
(repeat (sslength oc)
(setq i (1+ i) voc (vlax-ename->vla-object (ssname oc i)) ocn (vlax-safearray->list (vlax-variant-value (vla-get-center voc))) nob (vla-copy vob))
(vla-move nob (vlax-3d-point obn) (vlax-3d-point ocn)) (vla-delete voc))
(vl-cmdf "._undo" "e")
(princ))

07.01.2015 10:41
80045    
BLack|E

[8] Kıdemli Uzman

Online Durumu

112 ileti
Teknik Ressam
ANKARA

alumina çok teşekkür ederim. Allah razı olsun. Komutu kullandıkça seni hatırlayacağız.

_____________________
M.Ertan KIRTIL
Teknik Ressam
Konstrüktör

07.01.2015 10:48
80046    
alumina

[70] Editör

Online Durumu

599 ileti
Insaat Muhendisi
Istanbul

Allah sizden de razi olsun. Iyi calismalar.

07.01.2015 22:54
80056    
Travaci

[70] Editör

Online Durumu

2078 ileti
Teknik Ressam
Konstantinopol

Block u insert ederken scale e ihtiyaç duymuyorsa buda çeşit olsun

Kod:

(defun c:c2b (/ ob di ci n) (vl-load-com) (prompt "\nSelect block:")
  (if (setq ob (ssget "+.:s" (list (cons 0 "insert"))))
    (if (setq di (getdist "\nSpecify diameter of circle:"))
      (if (setq ci (ssget (list (cons 0 "circle") (cons 40 (/ di 2)))))
        (progn (setq n -1)
          (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
          (while (< (setq n (1+ n)) (sslength ci))
            (vla-InsertBlock (vla-get-modelspace (vla-get-activedocument
              (vlax-get-acad-object))) (vlax-3d-point (vlax-safearray->list
                (vlax-variant-value (vla-get-Center (vlax-ename->vla-object
                  (ssname ci n)))))) (vla-get-EffectiveName
                    (vlax-ename->vla-object (ssname ob 0)))  1 1 1 0)
            (vla-delete (vlax-ename->vla-object (ssname ci n))))
          (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
        )
      )
    )
  ) (princ)
)

07.01.2015 23:14
80058    
alumina

[70] Editör

Online Durumu

599 ileti
Insaat Muhendisi
Istanbul

Eline saglik Trvaci

08.01.2015 01:29
80059    
Travaci

[70] Editör

Online Durumu

2078 ileti
Teknik Ressam
Konstantinopol

alumina


Ozaman bide seninkinden olsun

Kod:

(defun c:c2b2 (/ ob di ci) (vl-load-com) (prompt "\nSelect block:")
  (if (setq ob (ssget "+.:s" (list (cons 0 "insert"))))
    (if (setq di (getdist "\nSpecify diameter of circle:"))
      (if (setq ci (ssget (list (cons 0 "circle") (cons 40 (/ di 2)))))
        (progn (setq n -1)
          (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
          (while (< (setq n (1+ n)) (sslength ci))
            (vla-move (vla-copy (vlax-ename->vla-object (ssname ob 0)))
              (vlax-3d-point (vlax-safearray->list (vlax-variant-value
                (vla-get-InsertionPoint (vlax-ename->vla-object
                  (ssname ob 0)))))) (vlax-3d-point (vlax-safearray->list
                    (vlax-variant-value (vla-get-center
                      (vlax-ename->vla-object (ssname ci n)))))))
            (vla-delete (vlax-ename->vla-object (ssname ci n))))
          (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
        )
      )
    )
  ) (princ)
)

09.01.2015 05:04
80089    
alumina

[70] Editör

Online Durumu

599 ileti
Insaat Muhendisi
Istanbul

Hadi bide seninkinden olsun

Kod:

(defun c:c22b (/ ob di ci os) (vl-load-com) (prompt "\nSelect block:")
   (if (setq ob (ssget "+.:s" (list (cons 0 "insert"))))
     (if (setq di (getdist "\nSpecify diameter of circle:"))
       (if (setq ci (ssget (list (cons 0 "circle") (cons 40 (/ di 2)))))
         (progn
           (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
           (vlax-for os (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
             (vla-InsertBlock (vla-get-modelspace (vla-get-activedocument
               (vlax-get-acad-object))) (vlax-3d-point (vlax-safearray->list
                 (vlax-variant-value (vla-get-Center os)))) (vla-get-EffectiveName
                     (vlax-ename->vla-object (ssname ob 0)))  1 1 1 0)
             (vla-delete os))
           (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
         )
       )
     )
   ) (princ)
)

09.01.2015 05:42
80090    
Travaci

[70] Editör

Online Durumu

2078 ileti
Teknik Ressam
Konstantinopol

Bunların sorumlusu hep BLack|E

09.01.2015 05:57
80092    
alumina

[70] Editör

Online Durumu

599 ileti
Insaat Muhendisi
Istanbul

bence bilerek yapıyor. dur bir sey sorayim bakalım kaç değişik sekilde yazacaklar diye bakıyor

09.01.2015 11:03
80093    
BLack|E

[8] Kıdemli Uzman

Online Durumu

112 ileti
Teknik Ressam
ANKARA

böyle olacağını bilseydim sormazdım. Fakat bu gelen zengin ve çeşitli cevaplar sizin ne kadar bilgili olduğunuzu göstermekte. Lisp yazmanın darısıda bana diyeyim. Başarılarımız daim olsun. Paylaşmak çok güzel bir şey hakatten.

_____________________
M.Ertan KIRTIL
Teknik Ressam
Konstrüktör

09.01.2015 16:12
80120    
ozkul

[10] Üstad

Online Durumu

423 ileti
İnşaat Teknikeri
Ankara

Blok içi yazıların mirror yapıldığında dönmemesi için bir lisp süper olurdu.

-------------------------------------
Çizim Okulu

11.01.2015 00:06
80129    
ehya

[90] Yönetici

Online Durumu

3181 ileti
Teknik Ressam
Ankara

Öyle bir lisp olmaz. olsa idi gerçekten süper olurdu

11.01.2015 00:13
80130    
alumina

[70] Editör

Online Durumu

599 ileti
Insaat Muhendisi
Istanbul

bloğun içine girip text i düzeltsek sanki diğer bloklardaki ayni kalacak dimi yani

13.01.2015 17:06
80147    
kerem1453

[8] Kıdemli Uzman

Online Durumu

111 ileti
teknik ressam
ankara

aşagıdaki lisptte yön tanımlamasını mouse ile belirledigim yönde olması için nasıl bir değişiklik yapılması lazım.

Kod:

(defun c:OL1 (/)
   (setq  ya (getpoint "\nBİRİNCİ NOKTAYI GÖSTER: "))
   (setq  yb (getpoint "\nikinci NOKTAYI GÖSTER: "))
   (setq  yc (getpoint "\nson NOKTAYI GÖSTER: ")) 
   (setq yna (polar ya 0 20))  bu ve alt satırda 0 yönünde değilde mouse ile belirlediğim yön olması için.
   (setq ynb (polar ya 0 40))   
   (command "layer" "set" "aa" "")
   (command "_.DIMSTYLE" "" "aa" )
   (command "dimlinear" ya yb yna)
   (command "dimcontinue" yc "" "")
   (command "dimlinear" ya yc ynb)
   (princ)

)


ehya (20.01.2015 15:25 GMT)

20.01.2015 12:31
80201    
elk21

[40] Gold üye

Online Durumu

20 ileti
elektrik teknikeri
diyarbakır

Kod:

(defun c:uU ()
(setvar "modemacro" "Archme Design by --> EhYa <--")
(vl-load-com)
(setq secim (ssget '((-4 . "<OR")
(0 . "LINE")
(0 . "LWPOLYLINE")
(0 . "ARC")
(0 . "ELLIPSE")
(0 . "SPLINE")
(0 . "CIRCLE")
(-4 . "OR>")
)
)
)
(if (= secim nil)
(progn
)
(progn
(setq sayim (sslength secim))
(setq toplami 0
c 0
)
(while (< c sayim)
(setq teksecim (ssname secim c))
(setq tanimi (cdr (assoc 0 (entget teksecim))))
(if (= tanimi "ARC")
(progn
(setq data (vlax-ename->vla-object teksecim))
(setq uz-bul (vla-get-arclength data))
(setq toplami (+ toplami uz-bul))
))
(if (or (= tanimi "LINE")(= tanimi "LWPOLYLINE")(= tanimi "POLYLINE"))
(progn
(setq data (vlax-ename->vla-object teksecim))
(setq uz-bul (vla-get-length data))
(setq toplami (+ toplami uz-bul))
)
)
(if (= tanimi "CIRCLE")
(progn
(setq data (vlax-ename->vla-object teksecim))
(setq uz-bul (vla-get-circumference data))
(setq toplami (+ toplami uz-bul))))
(if (or (= tanimi "ELLIPSE")(= tanimi "SPLINE"))
(progn
(command "._area" "e" teksecim)
(setq uz-bul (getvar "perimeter"))
(setq toplami (+ toplami uz-bul))))
(setq c (+ c 1))
)
(alert (strcat "\nsait Toplam Uzunluk: " (rtos (/ toplami 100) 2 2)" metre"))

)
)
(princ)
)


ARKADAŞLAR BU LİSP NEDİR NE İŞE YARAR VE NASIL KULLANILIR SAYIN ADMINIM EHYA HOCAM DAHA İYİ BİLİR SAYGILARIMLA


ehya (20.01.2015 15:25 GMT)

20.01.2015 12:51
80203    
ehya

[90] Yönetici

Online Durumu

3181 ileti
Teknik Ressam
Ankara

Seçilen nesnelerin uzunluklarını toplar ve sonucu verir.

- Autocad'i aç
- APPLOAD komutunu çalıştır.
- Ekrana gelen tablodan lsp dosyasını seç ve LOAD butonuna bas.
- Autocad'e geri dön.
- UU komutunu çalıştır ve nesneleri seçip enter'a bas.

20.01.2015 13:08
80204    
elk21

[40] Gold üye

Online Durumu

20 ileti
elektrik teknikeri
diyarbakır

SAYIN EHYA HOCAM BENİ AYDINLATTIĞINIZ İÇİN SİZE ÇOK TEŞEKKÜR EDERİM...




BANA BİR HARF ÖĞRETİN KIRKYIL KÖLESİ OLURUM Hz ALİ

20.01.2015 13:24
80205    
elk21

[40] Gold üye

Online Durumu

20 ileti
elektrik teknikeri
diyarbakır

BANA BİR HARF ÖĞRETENİN KIRKYIL KÖLESİ OLURUM HAZ.ALİ

21.01.2015 17:13
80223    
elk21

[40] Gold üye

Online Durumu

20 ileti
elektrik teknikeri
diyarbakır

;;;Dikkat:Asagidaki aciklamalar orta ve ust duzey lisp
;;; programi ile ilgilenen kullanicilar icindir.
;;;
;;;asagidaki satirlari copy komutuyla alip notepad i
;;;actiktan sonra paste ile yapistirin. Text dosyasinin
;;; adini duzenleyin ve uzantisini *.lsp yapin. Autocadi
;;;acin ve "appload" komutuyla bu dosyayi bulup yukleyin.
;;;calistirmak icin komut satirindan "ss" yazip entere basin.
;;;* *
;;;* =) freeMUST =) ;;;* *
;;;* Bilgi evrenseldir *
;;;* paylasmak mutluluktur *
;;;* freemust@gmail.com ;;;* *
;;;Asagidaki lisp sadece "lwpline" lardan olusan bir secim seti olusturur.
;;;Herbir pline in baslangic ve bitis noktasindan bir cizgi cizer ve "pedit"
;;;komutuyla son cizilen cizginin bir butun olmasini saglar. SOn olarak da
;;;uclari kapatilarak olusturulan yeni pline in alanini yazar.
;;;* *
(DEFUN C:ss (/ secim_kumesi sayac siradaki_pline
pl_ozellik pl_nokta pl_ilk_nokta pl_son_nokta
pl_alan pl_toplam_alan
)
;;bir secim_kumesi olustur. ssget komutu icindeki '((0 . "LWPOLYLINE"))
;;kismi sadece pline leri secmek icin kullanilir istenirse bu kisim komut satirindan cikaribilir.
(setq secim_kumesi (ssget '((0 . "LWPOLYLINE"))))

;; pl_toplam_alan degiskeni olustur ve sifir degeri ata
(setq pl_toplam_alan 0)
;; sayac degiskeni olustur ve sifir degeri ata
(setq sayac 0)

;;sayacin sifir degeri asagida yerine konur. secim_kumesi icindeki ilk
;;nesneye ait, acad icindeki gomulu obje koduna ulasilir.
(setq siradaki_pline (ssname secim_kumesi sayac))

;;secim_kumesi icindeki nesne kodlari oldugu surece gongu devam eder.
;;siradaki_pline degeri "t"yada"true" oldugu surece dongu surer.
;;"t"yada"true" demek siradaki_pline degerinin varligi ve bir deger
;;alabildigi anlamina gelir. eger siradaki_pline=nil oldugunda
;;while dongusunden cikilir. asagida; siradaki_pline=nil degerini
;;sadece secim kumesinde hicbir eleman kalmadiginda alir.
(while siradaki_pline
;;siradaki_pline obje koduna ait nesneyi olusturan butun ozelliklere
;;ulasilir.istenirse bunlar (print pl_ozellik) diyerek gorulur

(setq pl_ozellik (entget siradaki_pline))
;;; (print pl_ozellik)
;;bu nese ozellikleri listesinden pline baslangic noktasi koduna
;;ulasilir. Acad icinde nesne baslangic kodlari = 10 dur. ve
;; (...... ( 10 "x koord" "z koord" "z koord") .... ) seklindedir.
(setq pl_nokta (assoc 10 pl_ozellik))

;;buldugumuz ilk noktayi (pl_nokta), pl_ilk_nokta degerine atiyoruz
(setq pl_ilk_nokta (cdr pl_nokta))


;;secilen pline ait noktalar oldugu surece while dondusu surer.
(while pl_nokta
;;dongude bulunan noktayi pl_son_nokta degerine atayıyoruz
(setq pl_son_nokta (cdr pl_nokta))
;;burasi onemli... yukardaki (print pl_ozellik) komutu kullanarak
;;ekranda yazanlara bakmissaniz pek cok nokta oldugu gorulur.
;;biz sirasiyla bu pl_ozellik icindeki noktalari listeden cikarip
;;kalan listeyi tekrar pl_ozellik degerine atayacagiz ki bir
;;sonraki while dongusunde kullanalim.
(setq pl_ozellik (cdr (member pl_nokta pl_ozellik)))
;;while nin donguye devam etmesi icin, hala nokta (pl_nokta degeri yani)
;;varmi diye bakiyoruz.
(setq pl_nokta (assoc 10 pl_ozellik))
)


;;pline ait baslangic ve son noktaya cizgi cizer
(command "_.line" pl_ilk_nokta pl_son_nokta "")

;;simdi bu cizgiyi siradaki_pline son olusturulan cizgiyi birlestirecegiz.
(command "_.pedit" siradaki_pline "_join" "_last" "" "")

;;pline ait alan bulunur
(command "_.area" "_o" siradaki_pline)
(setq pl_alan (getvar "area"))
;; alan yazdirilir
(princ (strcat "n" (itoa (1+ sayac)) ". pline alani = " (rtos pl_alan 2)))
;;bulunan alan tolam alan icine eklenir
(setq pl_toplam_alan (+ pl_toplam_alan pl_alan))

;;sayac degerini while dongusu icin bir arttiralim ki secim setindeki
;;diger pline lara ulasalim.
(setq sayac (1+ sayac))
;;siradaki_pline=true kontrolu... yani secim setinde baska sectigimiz
;;pline var mi. Eger yoksa yani siradaki_pline=nil ise donguden cikilir
(setq siradaki_pline (ssname secim_kumesi sayac))
)
(princ (strcat "ntoplam pline alani = " (rtos pl_toplam_alan 2)))
(princ)
)
(PRINC "--> 'www.autocadokulu.com' Çizim yardımları yüklendi !")




arkadalar bu lisp nedir nasıl kullanabilirim..




BANA BİR HARF ÖĞRETENİN KIRKYIL KÖLESİ OLURUM HAZ.ALİ

21.01.2015 17:35
80224    
alumina

[70] Editör

Online Durumu

599 ileti
Insaat Muhendisi
Istanbul

Secilen polyline nesnelerin uclarını kapatarak toplam alanlarını hesaplar.
Yalnız;
1- acıklamalar icerisinde hatalı bir ifade var. Polyline nesnenin sadece baslangıc degil butun kose noktalarının dxf kodu 10 dur.
2- butun polyline nesneleri sectirip uclarını kapatıyor. Peki secilen polyline nesne kapalı ise ne olacak? O yuzden once secilen nesnenin kapalı olup olmadıgına bakılmalı, kapalı degilse kapatılmalıdır.
3- polyline nesne acıksa, kapatmak icin ucuna cizgi cizip editlemeye gerek yoktur !!!!

(setq pl_ozellik (entget siradaki_pline))
;;; (print pl_ozellik)
;;bu nese ozellikleri listesinden pline baslangic noktasi koduna
;;ulasilir. Acad icinde nesne baslangic kodlari = 10 dur. ve
;; (...... ( 10 "x koord" "z koord" "z koord") .... ) seklindedir.
(setq pl_nokta (assoc 10 pl_ozellik))

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] > 35 < [39] Sonraki Sayfa
Copyright © 2004-2018 | Tüm Hakları Saklıdır | 676 | Site haritası | İstatistikler | Hakkımızda | Kadromuz | Gizlilik | Reklam