AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoLISP > Lisp istekleri
25.03.2017 15:58    
alves
fillet komutunda ile iki ayrı layerdeki çizgileri birleştiriyorum. benim burad sizden isteğim 1. çizgi tipim sarı 2.çizgi tipim kırmızı varsayalım. fillet komutu gibi bir lisp ile birinci seçtiğim çizgiyle 2. çizgi tipim fillet gibi aypıtımda aynı tip renk olmasını istiyorum. bunun için bir lisp yazılmışmıydı. forumda aradım bulamadım. yardımlarınızı bekliyrum

27.03.2017 11:01    
alumina
Alıntı
alves :

Kod:

(defun c:flt (/ fl ss sl ns fr)
  (if (setq fl (getdist "\nRadius:"))
    (if (setq ss (ssget ":s" '((0 . "line"))))
      (progn (redraw (setq sl (ssname ss 0)) 3)
        (if (setq ns (ssget ":s" '((0 . "line"))))
          (progn (setvar 'cmdecho 0) (setq fr (getvar 'filletrad)) (setvar 'filletrad fl)
            (command "._undo" "be" "._fillet" sl (ssname ns 0)
              "._matchprop" sl (ssname ns 0) "" "._matchprop" sl (entlast) ""
              "._undo" "e") (setvar 'filletrad fr) (setvar 'cmdecho 1)
          )
        ) (redraw sl 4)
      )
    )
  ) (prin1)
)
28.03.2017 16:14    
alves
hocam çok teşekkür ederim. radius değeri geliyor her seferinde onu 0 yapmak zorunda kılıyorum. her zaman onun 0 olma şansı varmıdır.

22.04.2017 13:00    
waytooraider
Merhaba,
Xref dosyasında yada kilitli bloklu objelerde bulunan yazıları ,patlatmadan (text,block,att..) sanki objenin içine girip, ctrl c ile,yazıyı hafızaya almasını istiyorum. CTRL v yaptığımda ise o yazıyı mtext olarak paste yapsın.Arşivinde böyle bir lispi olan varsa ve paylaşırsa sevinirim.

waytooraider (24.04.2017 04:47 GMT)

26.04.2017 14:17    
BLack|E
İyi mesailer

aşağıdaki kot'ta iki nokta seçtirip if ile çıkan açıyı 90 dereceden küçükse bu işlemi yap demek istiyorum ama hata var ve ben bulamıyorum
sizce nerede yazım ya da mantık hatası olabilir. Yardımcı olursanız mutlu olurum.

Kod:

(setq 1sec (getpoint "\n1.Noktayi Secin:"))
(setq 2sec (getpoint "\n2.Noktayi Secin:"))
(setq aci (angtos (angle 1sec 2sec)))

(if (< aci 90)
(progn
(setq mesafe 100)
(setq 1secc (polar 1sec (angtof "90") mesafe))
(setq 2secc (polar 2sec (angtof "180") mesafe))
(setq mer (inters 1sec 1secc 2sec 2secc))
(command "_.point" mer "")
))
27.04.2017 07:13    
miyatu
Alıntı
BLack|E :
İyi mesailer

aşağıdaki kot'ta iki nokta seçtirip if ile çıkan açıyı 90 dereceden küçükse bu işlemi yap demek istiyorum ama hata var ve ben bulamıyorum
sizce nerede yazım ya da mantık hatası olabilir. Yardımcı olursanız mutlu olurum.

Kod:

(setq 1sec (getpoint "\n1.Noktayi Secin:"))
(setq 2sec (getpoint "\n2.Noktayi Secin:"))
(setq aci (angtos (angle 1sec 2sec)))

(if (< aci 90)
(progn
(setq mesafe 100)
(setq 1secc (polar 1sec (angtof "90") mesafe))
(setq 2secc (polar 2sec (angtof "180") mesafe))
(setq mer (inters 1sec 1secc 2sec 2secc))
(command "_.point" mer "")
))



(setq aci (angtos (angle 1sec 2sec))) ifadesi string döner bu nedenle
(< aci 90) ifadesi hata ile döner ve fonksiyon çalışmayı durdurur.
hata almamak için aci değişkenini integer türüne çevirmelisiniz.

Ayrıca yazmış olduğunuz fonksiyonda aynı iki nokta için seçim sırası değiştirilirse farklı açılar elde edersiniz.
Örnegin 0,0,0 koordinatında +x yönünde 100 birimlik çizilen bir çizginin açısı 0 derece iken
100,0,0 koordinatından -x yönünde 100 birimlik çizilen bir çizginin açısı 180 derecedir.

Ayrıca
(setq mer (inters 1sec 1secc 2sec 2secc)) ifadesini
(setq mer (inters 1sec 1secc 2sec 2secc nil)) şeklinde yazarsanız koordinatlarınızı kesişim noktası olmasa dahi uzantılarının kesişim noktasını verecektir.
Böylece
(command "_.point" mer "") ifadesi tanımsız kalmayacaktır.
Kod:

(if (< (atof
(angtos (angle (setq 1sec (getpoint "\n1.Noktayi Secin:"))
(setq 2sec (getpoint "\n2.Noktayi Secin:"))
)
0
2
)
       )
       90
    )
  (progn
    (command "_.point"
     (inters 1sec
     (polar 1sec (angtof "90") 100)
     2sec
     (polar 2sec (angtof "180") 100)
     nil
     )
     ""
    )
  )
)

miyatu (27.04.2017 08:34 GMT)

28.04.2017 08:46    
BLack|E
Alıntı
miyatu :


miyatu üstat teşekkür ederim dediğiniz gibi string olarak dönmesinden dolayı hata veriyormuş.
diğer if olasılıklarını yer kaplamasın diye paylaşmamıştım. inters'teki nil bilgisi içinde ayrıca teşekkürler.
Kolay gelsin.

28.04.2017 10:43    
Travaci
miyatu

BLack|E

Bir işlem yaptığımız için progn a gerek yok arkadaşlar.

28.04.2017 11:00    
miyatu
Alıntı
Travaci :
miyatu

BLack|E

Bir işlem yaptığımız için progn a gerek yok arkadaşlar.


Haklısın... Teşekkürler...

waytooraider

Merhaba,
Xref dosyasında yada kilitli bloklu objelerde bulunan yazıları ,patlatmadan (text,block,att..) sanki objenin içine girip, ctrl c ile,yazıyı hafızaya almasını istiyorum. CTRL v yaptığımda ise o yazıyı mtext olarak paste yapsın.Arşivinde böyle bir lispi olan varsa ve paylaşırsa sevinirim.


Benim dosya içerisinde veya dosyalar arasında text kopyalamak için kullandığım fonksiyon belki işini görebilir.

Fonksiyonla

Block, xref, text objelerinden kopyalama yaparak yine block, text objelerinin üstüne yazar yada yeni text objesi üretir.
Previous alt fonksiyonu ile son yapmış oldugunuz kopyalama değerini tekrar çagırı, bu fonksiyon sayesinde bir dosya içerisinden kopyalanan deger başka bir dosya içerisine çağırılabilir.

Kod:

;**************************************************************************************************
;**                                     MAIN                                                     **
(defun c:yy ()
  (vl-load-com)
  (initget 1024 "Previous")
  (setq ref (nentsel "\nSelect object or [Previous]"))
  (if (/= ref "Previous")
    (progn
      (setq ref_8  (cdr (assoc 8 (entget (car ref))))
    ref_1  (cdr (assoc 1 (entget (car ref))))
    ref_40 (cdr (assoc 40 (entget (car ref))))
    ref_41 (cdr (assoc 41 (entget (car ref))))
    ref_7  (cdr (assoc 7 (entget (car ref))))
      )
      (if (/= nil (vl-string-position (ascii "|") ref_7))
(progn
  (setq ref_s (tblsearch "STYLE" ref_7)
ref_s_70 (cdr (assoc 70 ref_s))
ref_s_40 (cdr (assoc 40 ref_s))
ref_s_3 (cdr (assoc 3 ref_s))
ref_7 (substr ref_7 (+ 2 (vl-string-position (ascii "|") ref_7)))
  )
  (if (null (tblsearch "STYLE" ref_7))
    (progn
      (style)
    )
  )
  (setq
    s_data (open (strcat (getvar "savefilepath") "S_DATA.TXT")
"W"
   )
  )
  (write-line (rtos ref_s_70 2 0) s_data)
  (write-line (rtos ref_s_40 2 1) s_data)
  (write-line ref_s_3 s_data)
  (write-line ref_7 s_data)
  (close s_data)
)
(progn
  (setq ref_s (tblsearch "STYLE" ref_7)
ref_s_70 (cdr (assoc 70 ref_s))
ref_s_40 (cdr (assoc 40 ref_s))
ref_s_3 (cdr (assoc 3 ref_s))
  )
  (setq
    s_data (open (strcat (getvar "savefilepath") "S_DATA.TXT")
"W"
   )
  )
  (write-line (rtos ref_s_70 2 0) s_data)
  (write-line (rtos ref_s_40 2 1) s_data)
  (write-line ref_s_3 s_data)
  (write-line ref_7 s_data)
  (close s_data)
)
      )
      (setq
y_data
(open (strcat (getvar "savefilepath") "Y_DATA.TXT") "W")
      )
      (write-line ref_8 y_data)
      (write-line ref_1 y_data)
      (write-line (rtos ref_40 2 1) y_data)
      (write-line (rtos ref_41 2 1) y_data)
      (close y_data)
    )
    (progn
      (setq
y_data
(open (strcat (getvar "savefilepath") "Y_DATA.TXT") "r")
      )
      (setq ref_8 (read-line y_data))
      (setq ref_1 (read-line y_data))
      (setq ref_40 (atoi (read-line y_data)))
      (setq ref_41 (atoi (read-line y_data)))
      (close y_data)
      (setq
s_data
(open (strcat (getvar "savefilepath") "S_DATA.TXT") "r")
      )
      (setq ref_s_70 (atoi (read-line s_data))
    ref_s_40 (atoi (read-line s_data))
    ref_s_3  (read-line s_data)
    ref_7  (read-line s_data)
   
      )
      (close s_data)
    )
  )
  (prompt "\nDegistirilecek texti sec yada Nokta sec:")
  (setq dd 0)
  (while (/= nil dd)
    (while (= (car (setq #grread (grread t 5 0))) 5)
      (redraw)
      (setq p1 (cadr #grread))
      ;(LM:displaygrtext p1 (LM:grtext ref_1) 1 15 -31)
    )
    (if (= (car #grread) 3)
      (progn
(setq sset (car (nentselp (cadr #grread))))
(if (= sset nil)
  (progn
    (text_yaz)
  )
  (progn
    (text_deg sset)
  )
)
      )
    )
    (if (= (car #grread) 2)
      (progn
(setq dd nil)
(redraw)
      )
    )
  )
)






;**                                                                                              **
;**************************************************************************************************

;**************************************************************************************************
;**                                     TEXT YAZ                                                 **

(defun text_yaz ()
  (entmake (list
     (cons 0 "TEXT")
     (cons 100 "AcDbEntity")
     (cons 8 ref_8)
     (cons 100 "AcDbMText")
     (cons 10 (cadr #grread))
     (cons 1 ref_1)
     (cons 40 ref_40)
     (cons 41 ref_41)
     (cons 7 ref_7)
   )
  )
)

;**                                                                                              **
;**************************************************************************************************

;**************************************************************************************************
;**                                       TEXT DEGISTIR                                          **

(defun text_deg (slist)
  (setq #dt (entget  slist))
  (setq #dt (subst (cons 1 ref_1) (assoc 1 #dt) #dt))
  (entmod #dt)
)

;**                                                                                              **
;**************************************************************************************************

;**************************************************************************************************
;**                                       MESAJ                                                  **

(PRINT "MIYATU TEXT KOPYALAMA YUKLENDI, CALISTIRMAK ICIN [YY] YAZ")

;**                                                                                              **
;**************************************************************************************************

;                                 TEXTSTYLE TANIMLANIYOR                                          ;
(defun style ()
    (entmake
      (list
(cons 0 "STYLE")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbTextStyleTableRecord")
(cons 2 ref_7)
(cons 3 ref_s_3)
(cons 40 ref_s_40)
(cons 70 ref_s_70)
      )
    )
  )
;                                                                                                 ;

miyatu (28.04.2017 12:57 GMT)

30.04.2017 08:49    
waytooraider
Çok teşekkür ederim.

01.05.2017 09:03    
furkan9333
Tıklanılan yerdeki text dosyalarını excel e aktarmanın bir yolu var mıdır ?

02.05.2017 12:03    
miyatu
Alıntı
furkan9333 :
Tıklanılan yerdeki text dosyalarını excel e aktarmanın bir yolu var mıdır ?


Bu şekilde sorulunca, aklıma dosyayı açıp ctrl+a ctrl+c ve excel de ctrl+v yapmak geliyor...

sorunuzu detaylandırır sanız belki bir şeyler yapılabilir...

04.05.2017 15:20    
waytooraider
Merhaba,
Alltaki lisp texti attribute bloğa çeviriyor.Lispi çalıştırmadan önce Justyfytext komutu ile textleri toplu olarak left'te çevirilmesi gerekiyor,
Lisp çalıştığında textler bloğa dönüşüyor ama ,textin rotationunu almıyor.Default olarak rotationu 0 'a setliyor.Acaba Textin orjinal rotationunu alarak bloğa çevirilmesi mümkün mü?
Kod:

(defun C:tab  (/ *error* acsp adoc align attobj block_coll block_def bname bref
  en hgt msg name names orig pmt sset style tag txtobj txtval val)
  (vl-load-com)
  (defun *error* (msg)
    (if adoc (vla-endundomark  adoc))
    (if
      (and msg
    (not
      (member
        msg
        '("console break"
   "Function cancelled"
   "quit / exit abort"
   ""
  )
      )
    )
      )
       (princ (strcat "\nError: " msg))
    )
    (setvar "nomutt" 0)
   
   
    (princ)
  )
(or adoc
     (setq adoc (vla-get-activedocument
    (vlax-get-acad-object))))
(or acsp
     (setq acsp (if (= (getvar "CVPORT") 1)
    (vla-get-paperspace
      adoc)
    (vla-get-modelspace
      adoc)
    )
    )
     )
(setq block_coll (vla-get-blocks adoc))
(vla-endundomark adoc)
(vla-startundomark adoc)
(while (tblsearch "BLOCK"
     (setq bname (getstring T "\nEnter block name: ")))
   (progn
     (alert "Block already exist, input another name")
     (setq msg "")
     (vlax-for obj  (setq names (vlax-map-collection block_coll 'vla-get-name))
       (setq name (vla-get-name obj))
       (if (not (wcmatch name "`**"))
  (setq msg (strcat msg (vla-get-name obj) "\n"))))
     (alert (strcat "Check existing blocks:\n" msg))))
(setvar "nomutt" 0)
(prompt
   "\nSelect a single text by single pick to get properies from\n")
(setvar "nomutt" 1)
(while (not
   (setq sset (ssget "_:S:L" (list (cons 0 "text")))))
   (alert (strcat "Select text again")))
(setq txtobj (vlax-ename->vla-object (ssname sset 0)))
(setvar "aflags" 4)
(setvar "attreq" 0)
(setvar "attdia" 1)
(setvar "nomutt" 0)
(prompt "\nCreating block with ActiveX method\n")
(setq orig (vlax-get txtobj 'insertionpoint)
       pmt  "Panel type"     ; prompt
       tag  "PANEL_TYPE"     ;tag
       val  (vlax-get txtobj 'textstring)   ;default value
       )
(setq hgt   (vlax-get txtobj 'height)
       style (vlax-get txtobj 'stylename)
       rot (vlax-get txtobj 'rotation)
       align (vlax-get txtobj 'alignment))
;; add block definition first
(setq block_def (vla-add block_coll (vlax-3d-point orig) bname))
;; change properties of the block definition
(vla-put-blockscaling block_def 1)
(vla-put-blockscaling block_def 1)
(vla-put-units block_def 1) ; possible enums: acInsertUnitsInches, acInsertUnitsUnitless, acInsertUnitsMillimeters, acInsertUnitsMeters, etc
;; add attribute
(setq attobj (vlax-invoke
  block_def
  'addattribute
  hgt
  acattributemodepreset
  pmt
  orig
  tag
  val))
;; change properties of the attribute
(vlax-put attobj 'alignment align)
(vlax-put attobj 'stylename style)
(vlax-put attobj 'rotation rot)
(vla-put-layer attobj "0")
(vlax-put attobj 'color 0)
(princ "\n")
(if (not (tblsearch "BLOCK" bname))
   (progn
     (alert "Error on  creating blocks")
     (exit)
     (princ))
   (progn
     (setvar "nomutt" 0)
     (prompt "\n\nSelect all texts to convert to blocks\n")
     (setvar "nomutt" 1)
     (if (setq tset (ssget "_:L" (list (cons 0 "text"))))
       (while (setq en (ssname tset 0))
  (setq txtobj (vlax-ename->vla-object en))
  (setq xlist (cons txtobj xlist))
  (setq orig (vlax-get txtobj 'insertionpoint))
  (setq txtval (vla-get-textstring txtobj))
  (setq orig (vlax-get txtobj 'insertionpoint))
  (setq bref (vlax-invoke acsp 'insertblock orig bname 1 1 1 0))
  (foreach attobj  (vlax-invoke bref 'getattributes)
    (if (eq tag (vla-get-tagstring attobj))
      (vla-put-textstring attobj txtval)
      (vla-update attobj))
    )
  (ssdel en tset)
  (entdel en)
  )
       )
     (setvar "nomutt" 0)
     )
   )
(vl-catch-all-apply
   '(lambda () (vlax-release-object block_def)))
(*error* nil)
(princ)
  )   
(princ "\n\t\t   Start command with: AXBT\n")
(prin1)

ehya (05.05.2017 07:23 GMT)

05.05.2017 07:24    
ehya
waytooraider



Kod karmaşası olmaması için düzenlemeyi sizin mesajınız üzerinden yaptım. Paylaştığınız lispi tekrar kopyalayın...

05.05.2017 10:15    
waytooraider
Çok teşekkürler.
Bloğa çecvirilecek tüm textler ilk tıklanan textin rotation'nunu alıyor.Kısacası acaba seçtiğim textleri bloğa çeviriken o anki rotationlarını koruyabilirler mi?

waytooraider (05.05.2017 10:22 GMT)

09.05.2017 08:06    
alumina
Alıntı
alves :

Niye illa lisp? Sec hepsini, properties'ten tek seferde degistir.

10.05.2017 14:07    
ayuksel
Merhabalar,

Okulda proje ödevi olarak hoca bir katı model çizen AutoLISP yazmamızı ve ölçülerin DCL ile ayarlanabilir olmasını istiyor. Benim modeli aşağıya yükledim.



Extrude etmeden önce tabanını çizmek ve R10 R50'lik filletları atmak istiyorum. Ancak, filletları nasıl atacağımı bir türlü anlayamadım. Şimdiye kadarki yazdığım kod aşağıdaki gibi. Yol gösterebilecek olan var mıdır?

Teşekkürler,

Not: LISP konusunda epey acemiyim.

Kod:

(defun c:abd ()
(setq wid1 60 len 115 wid1 60 wid2 22.5 hole1 20 hole2 15 rad1 22.5 rad2 20 rad3 50 rad4 10 rad5 7.5 he1 15 thi1 15 thi2 15 dist1 47.5 dist2 25 dist3 22.5 dist4 37.5)

;base
(setq pnt1 (getpoint "\nPlease select the starting point"))
(setq pnt2 (list (+ (car pnt1) (- len rad2))  (cadr pnt1)  (caddr pnt1)))
(setq pnt3 (list (car pnt2) (- (cadr pnt2) (- wid1 (* rad1 2)))  (caddr pnt1)))


(setq pnt4 (list (+ (car pnt3) (* rad2 2)) (cadr pnt3)  (caddr pnt1)))
(setq pnt5 (list (car pnt4) (+ (cadr pnt4) wid1)  (caddr pnt1)))
(setq pnt6 (list (- (car pnt4) (+ len rad2)) (cadr pnt5)  (caddr pnt1)))
(setq pnt7 (list (car pnt1) (cadr pnt1) (caddr pnt1)))



(command "line" pnt1 pnt2 pnt3 pnt4 pnt5 pnt6 pnt7 "")
)
10.05.2017 14:50    
ehya
ayuksel



tüm nesneleri line komutu ile bir defada yapmayın. tek tek yapın. fillet uygulanacak nesneleri hafızaya aldırıp fillet işlemini uygulayın.


örnek kod :

Kod:

(setq p1 (getpoint "\n1.nokta:")
      p2 (getpoint p1 "\n2.nokta:")
      p3 (getpoint "\n3. nokta:")
      p4 (getpoint p3 "\n4. nokta:"))
(command ".line" p1 p2 "")
(setq e1 (entlast))
(command ".line" p3 p4 "")
(setq e2 (entlast))
(command "_.fillet" e1 e2)
10.05.2017 15:33    
ayuksel
Alıntı
ehya :





Hocam çok teşekkür ederim. Dediğiniz gibi yapınca fillet'lar oldu.

Fakat extrude etmeden çizilenleri join ile birleştirmek gerekiyor sanırım.

Bu "command ...... "" " şeklinde LISP editöre yazdığımız komutları anlatan bir kaynak öneriniz var mıdır (İngilizce de olabilir)? Sitede bir kitap gördüm ama şimdi onu sipariş edip bekleyebilecek kadar vaktim yok maalesef.

Teşekkürler,

ehya (11.05.2017 07:39 GMT)

10.05.2017 15:42    
Travaci
ayuksel



Linkleri görebilmek için ÜYE olmalısınız.
Ö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] > 81 < [85] [90] [95] [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.283 saniye - Sorgu: 101 - Ortalama: 0.0127 saniye