23.10.2012 21:37    

Travaci
Kod:

...
...
...
(setq text (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString>%"))
(setq ayiklanan (substr text 1 (vl-string-position (ascii "/") text))) ; Bu kısmın çalışmamasının sebebi nedir ?
Her hangi bir text ile denediğimde "/" kadar olan kısmı alıyor.

27.10.2012 14:20    

ProhibiT
Kod:

;|***************************************************************************|
| fNd: Find String(s) in drawing.                                           |
|      Büyük/Küçük Harf duyarlıdır.                                         |
|      Hazırlayan: M. Şahin Güvercin  www.cizimokulu.com  08.11.2012        |
|---------------------------------------------------------------------------|;
(defun c:fNd (/ n PvT ssT StR)
  (setvar "cmdecho" 0) (command "_.undo" "group")
  (if (setq sTr (getstring T "\nAranan Yazı: ")
        ssT (ssget "x" (list (cons 1 (strcat "*" sTr "*")))))
    (setq n (sslength ssT))
    (progn (setq n 0)
      (princ (strcat "\n*" sTr "* Bulunamadı..."))))
  (while (not (minusp (setq n (1- n))))
    (setq PvT (ssname ssT n))
    (command "_.zoom" "o" PvT "") (command "_.zoom" "0.5x")
    (redraw PvT 3)
    (if (> n 0) (progn (initget 1 "Tamam Devam")
        (if (= (getkword "\nTamam/Devam: [T/D]") "Tamam")
          (progn (setq n 0) (redraw PvT 4)) (redraw PvT 4)))))
  (command "_.select" ssT "")
  (command "_.undo" "e") (princ))

ProhibiT (08.11.2012 08:40 GMT)

31.10.2012 08:42    

Travaci
Alıntı
Travaci :
Kod:

...
...
...
(setq text (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString>%"))
(setq ayiklanan (substr text 1 (vl-string-position (ascii "/") text))) ; Bu kısmın çalışmamasının sebebi nedir ?
Her hangi bir text ile denediğimde "/" kadar olan kısmı alıyor.




Birde alt seçenekleri nasıl koyabilirim ? "/" varsa öncelik olarak "/" a akdar olan kısmı yoksa daha sonra "@" e kadar olan kısmı oda yoksa " " (boşluk) a kadar olan kısmı gibi ...

22.11.2012 22:33    

Travaci
(setvar "ucsorg" ucs) Diyerek koordinat sistemini almaya çalışıyo idim : ) fakat (read only) olduğundan alamıyorum ne yapmalıyım ?

23.11.2012 08:06    

ehya
Travaci




"setvar" almak için değil, değiştirmek için kullanılan komuttur. Söylediğin ile yaptığn birbirini tutmuyor!!!
Bir değer "read only" ise değiştiremezsin. Ayrıca ne yapmak istediğini belirtsen.... belki başka sistem değişkenidir.

23.11.2012 08:27    

Travaci
Evet yanlış olmuş getvar yazıcaktım, yapmak istediğim ucs konumunu almak daha sonra ıslem yaptırmadan once ucs world e gecmek ıslem bıtınce tekrar eskı konuma gecmekti.
Kod:

(setq osmd (getvar "osmode"))
(setvar "osmode" 0 )
(setvar "osmode" osmd)
gibi..

23.11.2012 09:19    

ehya
Ucs konumunu alıp da ne yapacaksın? Ucs konumu her zaman 0,0,0 dır.. Çünkü bu değer Dünya koordinatıdır.

Yanlış sistem değerleriyle uğraşıyorsun gibime geliyor...

23.11.2012 09:37    

Travaci
Yanlış anlatıyorum sanırmı, ucs komutunu girdikten sonra birinci ve ikinci noktayı seçtirip ucs x ve ye yönünü değiştiriyoruz ya, işte o halini almak istiyorum, onuda sanırım ucsorg veriyordu.

24.11.2012 08:00    

rayden81
Merhaba ufak bir sorum olacak. Entmake ile text oluşturmaya çalışıyorum.

Kod:

(SETQ TH(LIST (CONS 0 "TEXT") (CONS 1 EGIMX1) (CONS 7 "Standard") (CONS 8 "L") (CONS 10 TXY) (CONS 40 YAZIH) (CONS 50 0)))
(ENTMAKE TH)


Bunu yapttığımda bir sorun olmadan yazdırıyor ama sonuna

Kod:

(cons 72 0) (cons 73 4)


gibi bir kod daha ekliyorum text i middle olarak oluşturmak için, bu durumda text i 0,0 koordinatında oluşturuyor ama textin dxf kodlarına baktığımda 0,0 değil başka bir koordinat görünüyor bana yardımcı olabilirmisiniz.

24.11.2012 08:41    

Travaci
Yapmak istediğini tam anlamdım ama middle center için bir
Örnek;
Kod:

(entmake
    (list
         (cons 0 "TEXT") 
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbText")
         (cons 10 y1)
         (cons 11 y1)
         (cons 1 son)
         (cons 40 sn)
         (cons 50 ca)
         (cons 41 1)
         (cons 72 1)
         (cons 8 "Olcu")
         (cons 73 2)
    )
)

14.12.2012 11:14    

Travaci
(command "LENGTHEN" "DE") komutunun çalışma mantığı nedir ? Daha doğrusu öğrenmek istediğim; bir line'nın tıkladığım ucuna işlem yaptırmak istiyorum, tıkladığım ucu nasıl algılatıcam.

14.12.2012 11:55    

ehya
travaci


Kod:

(setq ee (entsel))(command "lengthen" "de" 50 ee "")

14.12.2012 12:38    

Travaci
Yok hayır öyle demek istemedim, bir line' ım var tıkladığım uç kısma işlem yaptırcam
(command "LENGTHEN" "DE") bu işlemde tıkladığımız kısmı kırptığımız gibi ?
örneğin; tıkladığım kısma bir polygon çizdircem ama tıkladığım uc kısmın koordinatı nedir ? dersem daha doğru olur sanırım : )

14.12.2012 13:41    

ehya
Bu örnek kod işine yarayacaktır.


Kod:

(defun c:lcc ()
  (setq pt (entsel "\nLine seç:"))
  (setq pt10 (cdr (assoc 10 (entget (car pt))))
pt11 (cdr (assoc 11 (entget (car pt)))))

  (if (< (distance (cadr pt)pt10) (distance (cadr pt)pt11))
    (setq kor pt10)
    (setq kor pt11))
    (command "_.circle" kor 5)
  (princ))

14.12.2012 13:46    

Travaci
Buydu istediğim çok teşekkürler

20.12.2012 20:27    

Travaci
Kod:

;*********************** Merdiven çizen Program ***********************;
(defun c:mRd (/)
   (setvar "cmdecho" 0) (command "undo" "group")
   (setq osmd (getvar "osmode")) (setq lyr (getvar "clayer"))
   (if (not (tblsearch "Layer" "MERDIVEN"))
   (command "layer" "N" "MERDIVEN" "LW" "0.2" "MERDIVEN" "C" "57"
                        "MERDIVEN" "")) (princ)
   (setq bg (getreal "\nBasamak genişliği [Enter/Value] : "))
   (if (= bg nil)
      (progn
         (setq b1 (getpoint "\n Basamak genişliğini ölçünüz. ")
               b2 (getpoint b1 ) bg (distance b1 b2))))
   (setq my (getreal "\n  Merdiven yüksekliği [Enter/Value] : "))
   (if (= my nil)
      (progn
         (setq y1 (getpoint "\n    Merdiven yüksekliğini ölçünüz. ")
               y2 (getpoint y1) my (distance y1 y2))))
   (setq ba (getreal "\n     Basamak adeti: ")
         ry (/ my ba)
         S 0
         gp (getpoint "\n      Çizime başlanıcak nokta. "))
   (setvar "osmode" 0) (setvar "clayer" "MERDIVEN")
   (while (< S ba)
      (setq n1 (polar gp (/ pi 2) ry)
            n2 (polar n1 0 bg))
      (command "._pline" gp n1 n2 "")
      (setq gp n2
            S (+ S 1))
   )
   (setvar "osmode" osmd) (setvar "clayer" lyr) (command "_.undo" "e")
   (princ)
)
;**********************************************************************;

Çizilen basamakları tek bir polyline haline nasıl getirebilirim. ?
Teşekkürler

21.12.2012 13:50    

Harbi65
Alıntı
Travaci :

Çizilen basamakları tek bir polyline haline nasıl getirebilirim. ?
Teşekkürler




Kod:

;*********************** Merdiven çizen Program ***********************;
(defun c:mRd (/)
   (setvar "cmdecho" 0) (command "undo" "group")
   (setq osmd (getvar "osmode")) (setq lyr (getvar "clayer"))
   (if (not (tblsearch "Layer" "MERDIVEN"))
   (command "layer" "N" "MERDIVEN" "LW" "0.2" "MERDIVEN" "C" "57"
                        "MERDIVEN" "")) (princ)
   (setq bg (getreal "\nBasamak genişliği [Enter/Value] : "))
   (if (= bg nil)
      (progn
         (setq b1 (getpoint "\n Basamak genişliğini ölçünüz. ")
               b2 (getpoint b1 ) bg (distance b1 b2))))
   (setq my (getreal "\n  Merdiven yüksekliği [Enter/Value] : "))
   (if (= my nil)
      (progn
         (setq y1 (getpoint "\n    Merdiven yüksekliğini ölçünüz. ")
               y2 (getpoint y1) my (distance y1 y2))))
   (setq ba (getreal "\n     Basamak adeti: ")
         ry (/ my ba)
         S 0
         gp (getpoint "\n      Çizime başlanıcak nokta. "))
  (setvar "osmode" 0) (setvar "clayer" "MERDIVEN")

  (SETQ GRP (SSADD))

   (while (< S ba)
      (setq n1 (polar gp (/ pi 2) ry)
            n2 (polar n1 0 bg))
     (command "._pline" gp n1 n2 "")

     (SSADD (ENTLAST) GRP)

     (setq gp n2
           S (+ S 1))
     )
    (COMMAND "PEDIT" (SSNAME GRP 0) "J" GRP "" "")

   (setvar "osmode" osmd) (setvar "clayer" lyr) (command "_.undo" "e")
   (princ)
)
;**********************************************************************;

21.12.2012 18:48    

ProhibiT
Merhaba Harbi65 hocam, epey zamandır görememiştik sizi. Mesajınızı görünce içtenlikle çok sevindim :)

Biliyorum verilen kodun aslını hiç bozmadan, yalnızca sorulan sorunun çözüm yolunu vermişsiniz. Çözüm çok net ve yeterli. Araştıran, ilgili ve her gün kendini geliştiren yapısıyla ortamımıza katkıda bulunan travacı arkadaşımızın yazdığı kodu irdeleyerek başka bir bakış açısı getirmek istiyorum.

- Merdiven isimli Layer'ın çizimde bulunup bulunmadığını kontrol ederek, yoksa oluşturmak doğru bir yaklaşım, buna kimse itiraz edemez. Ben olsam Merdiven Layer'ını oluştururken (command kullanmadan doğrudan (entmake kullanırım. Daha risksiz, garantili ve temiz bir yöntem. Buna benzer bir örneği Linetype oluşturma konusunda vermiştim.

- Basamak genişliği ve merdiven yüksekliği değerleri alınırken, kullanıcının tercihine göre doğrudan sayısal değer veya iki nokta seçilerek mesafe girilmesi sağlanmış. Bu da doğru. Ama bu işlemi gerçekleştirmek için o kadar uzun kod yazmaya, kontroller yapmaya gerek yok ki. Önce (getreal ile sayı okumak, sayı girilmemişse, 2 tane (getpoint ile nokta okumak ve bunların arasındaki mesafeyi hesaplatmak, hem uzun hem de gereksiz bir yol olmuş.

Bunun yerine doğrudan (getdist kullanılarak, nümerik giriş veya iki nokta seçilerek mesafe girişi tek hamlede problemsiz gerçekleştirilebilir. (getdist kullanıldığında, kullanıcı sayısal değer girdiğinde değer okunur, değer girmeyip mouse ile bir nokta seçildiğinde ise, ikinci nokta seçimine gidilerek distance okunur.

Burada zaten tek bir gurup halinde yazılan (setq komutunun bir de (progn kullanılarak tekrar guruplanmasına da gerek yok.

- Basamak sayısı daima tamsayıdır. Böyle bir değeri (getreal ile almak yerine (getint ile almak her bakımdan daha doğru olur.

- Çizim başlangıç noktasını ekranda çizim görünmeden, afaki bir nokta olarak seçmek pek sıcak gelmedi bana.

- Rıht ve basamak çiftlerinin ayrı ayrı çizilip (üstelik command kullanarak) sonradan birleştirilmesine gerek var mı? Sistematik ve periyodik yer değiştirmelerden oluşan Rıht-Basamak çiftlerinin tamamını entmake kullanarak tek seferde çizmek daha doğru olmaz mı?

Oluşturulan objenin ekranda sürüklenip, görerek seçilecek noktaya yerleştirilmesi bana daha sıcak geliyor. Daha önce de örneklediğim gibi fonksiyonu karmaşıklaştırmadan (command ... pause...) kullanarak bunu çok basitçe yapmak mümkün.

Fonksiyon bahsettiğim şekilde yazıldığında osnap değişkenine de hiç ilişmediğimiz için, her zaman az veya çok riskli olan, saklama-geri yükleme işlemine de gerek kalmaz. Layer işlemleri konusunda da söylediklerim geçerli. entmake kullanarak objemizi doğrudan istediğimiz Layer'da oluşturduğumuz için, Layer değiştirme işlemlerine de gerek kalmıyor.

Ne demiş atalarımız; "Do not create the problem, and then try to resolve them" :)
Kod:

(defun c:mRd (/ bg bs eL ip my ry sp)
  (setvar "cmdecho" 0) (command "_.Undo" "Group")
  (if (not (tblsearch "Layer" "Merdiven"))
    (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord")
      (cons 100 "AcDbLayerTableRecord") (cons 2 "Merdiven") (cons 70 0)
      (cons 62 57) (cons 6 "Continuous") (cons 290 1) (cons 370 20))))
  (setq bg (getdist "\n  Basamak genişliği: ")
        my (getdist "\nMerdiven yüksekliği: ") ry (/ my bs)
        bs (getint  "\n     Basamak sayısı: ")
        sp (setq ip (cadr (grread T))) sp (list (car sp) (cadr sp))
        eL (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(67 . 0)
                 '(8 . "Merdiven") '(100 . "AcDbPolyline")
                 (cons 90 (1+ (* 2 bs))) '(70 . 0)))
  (while (> (setq bs (1- bs)) -1)
    (setq eL (append eL (list (cons 10 sp))
                         (list (cons 10 (list (car sp) (+ (cadr sp) ry)))))
          sp (list (+ (car sp) bg) (+ (cadr sp) ry))))
  (entmake (append eL (list (cons 10 sp))))
  (command "_.Move"  (entlast) "" ip Pause)
  (command "_.Undo" "e") (prin1))

21.12.2012 19:41    

Harbi65
Alıntı
ProhibiT :
Merhaba Harbi65 hocam, epey zamandır görememiştik sizi. Mesajınızı görünce içtenlikle çok sevindim :)

Biliyorum verilen kodun aslını hiç bozmadan, yalnızca sorulan sorunun çözüm yolunu vermişsiniz. Çözüm çok net ve yeterli. Araştıran, ilgili ve her gün kendini geliştiren yapısıyla ortamımıza katkıda bulunan travacı arkadaşımızın yazdığı kodu irdeleyerek başka bir bakış açısı getirmek istiyorum.




Merhaba Hocam.
Arada bir baksam da, evet bir süredir hem iş, hem de özel nedenlerden dolayı siteden biraz koptum... Arkadaşın mesajını görünce de sadece soruyu cevapladım. Kodlar inceleyince sizinde açıklama yaptığıınız gibi eleştirilecek şeyler vardı elbette. Travacı arkadaşımız azimle hızlı bir şekilde kendini geliştiren bi arkadaşımız olduğu için fazla kurcalamak istemedim. Hatalarla karşılaştıkça çözümü bulacağını düşünüyorum...

Merdiven lispi olarak daha pratik çözümler düşünmek lazım. basamak genişliği, rıht adedi, kat yüksekliği girince sadece geriye çizdirmesi kalıyor. Bu biraz mantıksız tabi ki. Basamak genişliklerinin ve rıht yüksekliklerinin standartları var.. Kat yüksekliğini gösterince bunları proğram içinde hesaplatmak daha mantıklı ve pratik çözüm olur...

Sitede benim Merdiven kesiti çizen bir lisp vardı ama arkadaşın kendi yazmaya çalışması kendini geliştirme adına daha doğru...

Prohibit Hocam bu arada benim bir sorum olacak;
BATTING ltype benzeri bir çizgi tipini load yapmadan sizin bahsettiğiniz gibi yüklemeye çalıştım ama başaramadım...
bu konuda yardımcı olabilir misin rica etsem...

21.12.2012 23:41    

Travaci
Yardımlarınız ve yorumlarınız için teşekkür ederim. Başımızdan eksik olmayın sizlerden öğrenicek çok şey var. Bu arada fonksiyonlarda entmake kulllanmamamın sebebi kodu yazdığım gibi buraya yapıştırdığımda aynı düzende olmuyor, hepsi sola yaslanıyor, teker teker her satıra boşluk bırakıyor butun kodu tekrar düzenliyorum, kısa olsun diye command kullanıyorum, kodu yapıştırmanın bir püf noktası varmı bilemedim, yoksa kod orjinalinde layer & cızgı tıpı açarken, line cızdırırken entmake kullanıyorum. Tekrar teşekkürler.

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] > 25 < [30] [35] [40] [43] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.337 saniye - Sorgu: 100 - Ortalama: 0.01337 saniye