AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoLISP > Lisp istekleri
21.04.2012 14:45    
ProhibiT
yyatkin komşum, aslında Lengthen komutuna hiç benzemez. :)
- Bir tek Line objelerini işleme alır.
- Çizginin uzunluğuyla hiç ilgilenmez.
- Aynı çizgiyi pozitif kırpma mesafesi değeriyle sürekli seçmeye devam ederseniz, çizgi boyu kırpma mesafesinden küçük olduğu anda, çizginin başlangıç ve bitiş noktalarını yer değiştirerek, çizgi boyunu bir kereliğine azaltmaz, artırır.

03.05.2012 09:52    
ProhibiT
Bir arkadaşımızın özel mesaj yazarak sorduğu "PolyLine'ın Orta Noktasını Bulma" sorusuna cevabımı, başkalarının da işine yarayabilir düşüncesiyle burada paylaşıyorum.



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


Linkinde paylaştığım fonksiyonda PolyLine Orta Noktasını bulma Algoritması zaten var.

Söz konusu işlem bir kaç türlü yapılabilir;
PoLyLine objesinin Vertex noktalarını ele alıp, bu noktaların,
x değerlerini toplayıp nokta sayısına bölersek Orta Noktanın x koordinatını,
y değerlerini toplayıp nokta sayısına bölersek Orta Noktanın y koordinatını buluruz.
Orta Noktanın z koordinatı, PoLyLine objesinin Elevation değeridir.
Kod:

(defun c:CnTr (/ vLo x y z m n)
  (vl-load-com) (princ "\nMerkezi bulunacak LwPolyline objesi seçiniz: ")
  (setq vLo (vlax-ename->vla-object
              (ssname (ssget ":s" (list (cons 0 "LwPoLyLine"))) 0))
        x 0 y 0 z (vlax-get-property vLo 'Elevation)
        pLs (vlax-safearray->list
              (vlax-variant-value
                (vlax-get-property vLo 'Coordinates)))
        m (length pLs) n (/ m 2))
  (while (not (minusp (setq m (- m 2))))
    (setq x (+ x (nth m pLs)) y (+ y (nth (1+ m) pLs))))
  (entmake (list (cons 0 "Point") (cons 10 (list (/ x n) (/ y n) z)))))
Bu yöntemle tüm segmentleri doğrusal olan PoLyLine'ın orta noktasını kusursuz bir şekilde buluruz. Eğer PoLyLine'ımızın doğrusal olmayan (Arc) segmentleri var ise, sonuç çok hassas olmayacaktır. Tüm segmentlerin doğrusal olduğu durumlarda ya da hassasiyetin birincil derecede önemli olmadığı durumlarda kullanılabilir.

Diğer bir yöntem;
Seçilen PolyLine Objesi, Önce Region'a çevrilir, Region Objesinin Centroid noktası bulunduktan sonra, işi biten region objesi silinir. Bu yöntemle her türlü PolyLine objesinin Orta Noktası doğru bir şekilde bulunur.
Kod:

(defun c:CnTr1 (/ pLn dLo vLo CnT)
  (vl-load-com) (princ "\nMerkezi bulunacak LwPolyline objesi seçiniz: ")
  (setq pLn (ssname (ssget ":s" (list (cons 0 "LwPoLyLine"))) 0))
  (if (/= (setq dLo (getvar "DeLObj")) 0) (setvar "DeLObj" 0))
  (command "_.Region" pLn "") (setvar "DeLObj" dLo)
  (setq vLo (vlax-ename->vla-object (entlast))
        Cnt (append
              (vlax-safearray->list
                (vlax-variant-value
                  (vlax-get-property vLo 'Centroid)))
              (list (vlax-get-property
                      (vlax-ename->vla-object pLn) 'Elevation)))
        vLo (entdel (entlast)))
  (entmake (list (cons 0 "Point") (cons 10 CnT))))
Her iki örnekte de, bulunan Orta Noktada bir point oluşturacak şekilde yazdım.

04.05.2012 11:30    
ProhibiT
Bir arkadaşımızın Özel mesaj ile isteği üzerine yazılan, farklı Layer'lardaki objeler seçilerek belirlenen boundary içinde kalan alanı hesaplayıp yazan AutoLisp fonksiyon.

- Bondary seçim setine eklenmek istenen Layer'da bir obje seçilmeye devam edildikçe seçim işlemi sürdürülür. Enter (veya sağ tuş) girilerek seçim işlemi sonlandırılır.

- Boundary seçimi yapılırken, seçili Layer'daki bir objeye tıklanırsa, ilgili Layer seçim setinden çıkarılır.

- Hesaplanacak Alan içinde bir noktaya tıklandığında, seçilen alanın sınırları kırmızı renkte belirginleştirilir.

- İmleç konumunda beliren ALan yazısı sürüklenerek istenen yere bırakılır.

- Sürükleme işlemi sırasında imlecin bulunduğu yerde mevcut bir Text varsa, bu obje highlight edilir, sol tıklanırsa mevcut Text içeriği değiştirilerek yeni hesaplanan ALan yazılır. Boş bir yere sol tıklanırsa, yeni ALan yazısı yerleştirilir. Sağ tıklanırsa, ALan yazısı yazılmaz, bir sonraki adımdan işleme devam edilir.

- Nokta seçilmeye devam edildikçe aynı Boundary Set'e göre yeni alan hesaplanıp yazılmaya devam edilir. Enter (veya sağ tuş) girilerek fonksiyon sonlandırılır.
Kod:

;|===========================================================================|;
;| SbR: Selective Boundary Area                                              |;
;| Obje seçilerek belirlenen Layer'larda bulunan objelerden oluşan Boundary  |;
;| içinde tıklanan noktaya göre hesaplanan ALan yazısı sürklenip belirlenen  |;
;| yere yerleştirilir.                                                       ;|
;|          Hayırlayan: M. Şahin Güvercin - www.autocadokulu.com             |;
;|---------------------------------------------------------------------------|;
(defun c:SbR (/ *error* aLo nLy Nob n PvT PnT Bnd ALn dro so sp0 sp a tp)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (defun *error* (/ er) (princ (strcat "\n" er)) (command "_.undo" "e")
    (setvar "cmdecho" 1) (prin1))
  (setq aLo (ssadd)) (princ "\nİşleme alınacak Layer'da\n ")
  (while (setq nLy (car (entsel "\rObje Seçiniz: ")))
    (setq nLy (cdr (assoc 8 (entget nLy)))
          Nob (ssget "x" (list (cons 0 "*Line,Arc") (cons 8 nLy)))
          n   (sslength Nob))
    (while (>= (setq n (1- n)) 0) (setq PvT (ssname Nob n))
      (if (ssmemb PvT aLo) (progn (ssdel PvT aLo) (redraw PvT 4))
        (progn (ssadd PvT aLo) (redraw PvT 3)))))
  (princ "\nHesaplacak alan içinde\n ")
  (while (setq PnT (getpoint "\rBir Yere Tıklayınız: "))
    (command "_.bpoly" "A" "B" "N" aLo "" "" PnT "")
    (setq Bnd (vlax-ename->vla-object (entlast))
          aLn (vlax-get-property Bnd 'Area))
    (vlax-put-property Bnd 'CoLor 1) (command "_.DrawOrder" "l" "" "f")
    (entmake (list '(0 . "Text") '(10 0 0 0) (cons 40 (getvar "TextSize"))
    (cons 1 (rtos aLn 2 (getvar "Luprec"))) '(50 . 0.0) '(72 . 1) '(11 0 0 0)))
    (setq dro (vlax-ename->vla-object (setq so (entlast))) sp0 '(0 0 0))
    (while (and (/= 3 (car (setq sp (grread T 4 2)))) (/= (car sp) 25))
      (if a (redraw (ssname a 0) 4))
      (vla-transformby dro (vlax-tmatrix
        (list (list 1 0 0 (- (car (cadr sp)) (car sp0)))
              (list 0 1 0 (- (cadr (cadr sp)) (cadr sp0)))
              (list 0 0 1 (- (caddr (cadr sp)) (caddr sp0))) (list 0 0 0 1))))
      (setq sp0 (cadr sp)) (entdel so)
      (if (setq a (ssget sp0 (list (cons 0 "*Text")))) (redraw (ssname a 0) 3))
      (entdel so))
    (if (= (car sp) 3) (progn
       (vla-transformby dro (vlax-tmatrix
         (list (list 1 0 0 (- (car (cadr sp)) (car sp0)))
               (list 0 1 0 (- (cadr (cadr sp)) (cadr sp0)))
               (list 0 0 1 (- (caddr (cadr sp)) (caddr sp0))) (list 0 0 0 1))))
        (entdel so)
        (if (setq tp (ssget sp0 (list (cons 0 "*Text"))))
          (vlax-put-property (vlax-ename->vla-object (ssname tp 0)) 'TextString
            (rtos aLn 2 (getvar "Luprec"))) (entdel so))) (vla-erase dro))
    (vla-erase Bnd)) (command "_.undo" "e") (setvar "cmdecho" 1) (prin1))
05.05.2012 05:05    
map
Merhaba Şahin bey yazışmalara bundan böyle burdan devam etmeye çalışacağım.Memnuniyetimizi zaten etrafımızla paylaşıyoruz levha'daki gibi :) , diğeri de şikayet demeyelimde eksiklerimizi de size bildiriyoruz.
Boundary'lerin ve text'lerin aynı tabakaya alınması amacı da şu olarak düşünmüştük Yapılan bu çalışmaları dijital ortamda teslim ettiğimizde farklı tabaka renkleri olarak görmek isteyecekler ama alanları kontrol etmek istediklerinde bu boundary'lere ihtiyaçları büyük ihtimalle olacak hangi alan nerden gelmiş ekranda görülebilecek diye düşünmüştük.
Ayrıca da en azından kendi işimiz olarak düşündüğümüzde 75 km yolun enkesitlerini düşünürsek bu kesitlerde önce kendimizi kontrol edebilmek , daha sonra da bizi kontrol eden mutlaka olacağından onlara yol gösterme anlamında kalıcı bir görüntü olsun hizmet olsun anlamında düşünmüştük , inanıyoruz ki böyle bi çalışmada bizim işimiz için özel bir iş olmayıp genel olarak herkesin işine yarayabilecek bir özellik olurdu.
Ama yinede tekrar teşekkür eder iyi çalışmalar dileriz...

05.05.2012 07:42    
ProhibiT
Bir de bu haliyle deneyin. Sizi kırmamak adına istemeyerek böyle bir şey yazdım. Tren gibi Enter serisi olan fonksiyon hiç hoş olmadı doğrusu. :)
Kod:

;|===========================================================================|;
;| SbA: Selective Boundary Area                                              |;
;| Obje seçilerek belirlenen Layer'larda bulunan objelerden oluşan Boundary  |;
;| içinde tıklanan noktaya göre hesaplanan ALan yazısı sürklenip belirlenen  |;
;| yere yerleştirilir. Nokta seçilmeye devam edildikçe aynı Boundary Set'e   |;
;| göre alan hesaplanıp yazılmaya devam edilir. Oluşturulacak Boundary       |;
;| objesi ve Alan yazısı için Layer seçilebilir, Enter girilirse Current     |;
;| Layer ile devam edilir. Yeni nokta seçilmeyip Enter  ile geçildiğinde     |;
;| fonksiyon başa döner, Yeni Layer'larla boundary set oluşturulabilir.      |;
;| tekrar Enter girilirse fonksiyon sonlanır.                                |;
;|          Hayırlayan: M. Şahin Güvercin - www.autocadokulu.com             |;
;|---------------------------------------------------------------------------|;
(defun c:SbA (/ *error* aLo nLy Nob Lyr aLo n PvT PnT Bnd oID ALn dro so sp0
         sp a tp) (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
   (defun *error* (/ er) (princ (strcat "\n" er)) (command "_.undo" "e")
     (setvar "cmdecho" 1) (prin1)) (setq aLo (ssadd)) (princ "\n ")
   (while (setq nLy (car (entsel "\rİşleme alınacak Layer'da Obje Seçiniz: ")))
     (while nLy (setq nLy (cdr (assoc 8 (entget nLy)))
                      Nob (ssget "x" (list (cons 0 "*Line,Arc") (cons 8 nLy)))
                      n   (sslength Nob))
       (while (>= (setq n (1- n)) 0) (setq PvT (ssname Nob n))
         (if (ssmemb PvT aLo) (progn (ssdel PvT aLo) (redraw PvT 4))
           (progn (ssadd PvT aLo) (redraw PvT 3))))
       (setq nLy (car(entsel "\rEkleme/Çıkarma için Obje Seçiniz: "))))
     (while (setq PnT (getpoint "\rHesaplacak alan içine Tıklayınız: "))
       (if Bnd (redraw Bnd 4)) (setq n (sslength aLo))
       (while(>=(setq n(1- n)) 0) (redraw(ssname aLo n) 3))
       (command "_.bpoly" "A" "B" "N" aLo "" "" PnT "")
       (setq Bnd (vlax-ename->vla-object (entlast))
             oID (itoa(vla-get-ObjectID Bnd)) aLn (vlax-get-property Bnd 'Area))
       (command "_.DrawOrder" "l" "" "f")(redraw (setq Bnd (entlast)) 3)
       (if (setq LyR (entsel (strcat "\rLayer değiştirmek için Obje seçiniz: <"
                            (getvar "CLayer") ">")))
         (setvar "clayer" (cdr (assoc 8 (entget (car LyR))))))
       (vlax-put-property (vlax-ename->vla-object Bnd) 'Layer (getvar "CLayer"))
       (redraw (setq Bnd (entlast)) 3)
       (entmake (list '(0 . "Text") '(10 0 0 0) (cons 40 (getvar "TextSize"))
                      (cons 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " oID
                      ">%).Area \\f \"%lu2%pr" (itoa (getvar "Luprec")) "\">%"))
                      '(50 . 0.0) '(72 . 1) '(11 0 0 0)))
       (command "_.UpDateField" (entlast) "")
       (setq dro (vlax-ename->vla-object (setq so (entlast))) sp0 '(0 0 0))
       (while (and (/= 3 (car (setq sp (grread T 4 2)))) (/= (car sp) 25))
         (if a (redraw (ssname a 0) 4)) (vla-transformby dro (vlax-tmatrix
                (list (list 1 0 0 (- (car (cadr sp)) (car sp0)))
                (list 0 1 0 (- (cadr (cadr sp)) (cadr sp0)))
                (list 0 0 1 (- (caddr (cadr sp)) (caddr sp0))) (list 0 0 0 1))))
         (setq sp0 (cadr sp)) (entdel so)
         (if (setq a (ssget sp0 (list '(0 . "*Text")))) (redraw (ssname a 0) 3))
         (entdel so))(if (= (car sp) 3)(progn(vla-transformby dro (vlax-tmatrix
          (list (list 1 0 0 (- (car (cadr sp)) (car sp0)))
                (list 0 1 0 (- (cadr (cadr sp)) (cadr sp0)))
                (list 0 0 1 (- (caddr (cadr sp)) (caddr sp0))) (list 0 0 0 1))))
          (entdel so) (if (setq tp (ssget sp0 (list (cons 0 "*Text"))))
            (vlax-put-property(vlax-ename->vla-object (ssname tp 0)) 'TextString
              (rtos aLn 2 (getvar "Luprec"))) (entdel so))) (vla-erase dro))
       (redraw Bnd 4) (setq n(sslength aLo))
       (while(>=(setq n(1- n)) 0)(redraw(ssname aLo n) 3)))
     (if aLo (progn (setq n (sslength aLo))
       (while(>=(setq n (1- n)) 0)(redraw (ssname aLo n) 4)))))
   (if aLo (progn (setq n (sslength aLo))
       (while(>=(setq n (1- n)) 0) (redraw (ssname aLo n) 4))))
   (command "_.undo" "e") (setvar "cmdecho" 1) (prin1))

ProhibiT (05.05.2012 12:53 GMT)

05.05.2012 08:38    
map
Şahin bey bizi kırmadığınız için teşekkür ederiz.
İstediğimize yakın bir lisp oldu fakat alanı yazmıyor sonunda hata veriyor.
occurred inside the *error* functiontoo many arguments hatası veriyor. İyi çalışmalar.

05.05.2012 12:56    
ProhibiT
Code Uppload ederken, tırnak içinde tırnak yazmak için kullandığımız \'lar kayboluyor. Field eklerken gene aynı hatayı yapmışım. Düzelttim şimdi tekrar alıp denerseniz problem olmayacaktır.

05.05.2012 14:48    
map
Şahin hocam merhaba çok teşekkür ederiz boundary ve alan text işi halloldu. Yeni farkına vardığımız bi sorun demiyim de programı kasan bi özellik tabaka seçimi yapıldığında bütün dosyadaki o tabakaya ait çizimi seçiyo. ve bu da programı kasıyor bunu kesitsel olarak küçültme olayı olabilirmi her kesit için komutu tekrar başlatalım . neden derseniz dosyalar ımız büyük 300-500-800 tane kesit olan dosyalarımız var bu da baya bi çizim demektir.Küçük dosyalarda sorun olmuyor da böyle büyük dosyalar olunca baya bi yoruyor programı.Eğer olursa kısa bi yolu varsa ricamız bu olacak sizi uğraştırmayacaksa eğer tabi.Teşekkür ederiz .İyi Çalışmalar dileriz...

06.05.2012 14:22    
ProhibiT
Seçim setini, tıklanan Layerdaki objelerin yalnızca ekranda görülenlerden oluşturacak şekilde düzenledim. Her kesit için tekrar çalıştırmanıza da gerek yok. Fonksiyon o anda aktif olan ekran sınırlarını algılayarak, görünen objelerden yeni boundary set oluşturur.
Kod:

;|===========================================================================|;
;| SbA: Selective Boundary Area                                              |;
;| Obje seçilerek belirlenen Layer'larda bulunan objelerden oluşan Boundary  |;
;| içinde tıklanan noktaya göre hesaplanan ALan yazısı sürklenip belirlenen  |;
;| yere yerleştirilir. Nokta seçilmeye devam edildikçe aynı Boundary Set'e   |;
;| göre alan hesaplanıp yazılmaya devam edilir. Oluşturulacak Boundary       |;
;| objesi ve Alan yazısı için Layer seçilebilir, Enter girilirse Current     |;
;| Layer ile devam edilir. Yeni nokta seçilmeyip Enter  ile geçildiğinde     |;
;| fonksiyon başa döner, Yeni Layer'larla boundary set oluşturulabilir.      |;
;| tekrar Enter girilirse fonksiyon sonlanır.                                |;
;|          Hayırlayan: M. Şahin Güvercin - www.autocadokulu.com             |;
;|---------------------------------------------------------------------------|;
(defun c:SbA (/ *error* aX aLo nLy p1 p2 Nob Lyr aLo n PvT PnT Bnd oID ALn dro
               so sp0 sp a tp)
   (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
   (defun *error* (/ er) (princ (strcat "\n" er)) (command "_.undo" "e")
     (setvar "cmdecho" 1) (prin1)) (setq aLo (ssadd)) (princ "\n ")
   (setq aX (/ (car (setq aX (getvar "ScreenSize"))) (cadr aX)))
   (while (setq nLy (car (entsel "\rİşleme alınacak Layer'da Obje Seçiniz: ")))
     (while nLy (setq nLy (cdr (assoc 8 (entget nLy)))
             p1 (mapcar '- (getvar "ViewCtr")
             (list (* (getvar "ViewSize") aX 0.5) (* (getvar "ViewSize") 0.5)))
             p2 (mapcar '+ (getvar "ViewCtr")
             (list (* (getvar "ViewSize") aX 0.5) (* (getvar "ViewSize") 0.5)))
                 Nob (ssget "c" p1 p2 (list (cons 0 "*Line,Arc") (cons 8 nLy)))
                 n   (sslength Nob))
       (while (>= (setq n (1- n)) 0) (setq PvT (ssname Nob n))
         (if (ssmemb PvT aLo) (progn (ssdel PvT aLo) (redraw PvT 4))
           (progn (ssadd PvT aLo) (redraw PvT 3))))
       (setq nLy (car(entsel "\rEkleme/Çıkarma için Obje Seçiniz: "))))
     (while (setq PnT (getpoint "\rHesaplacak alan içine Tıklayınız: "))
       (if Bnd (redraw Bnd 4)) (setq n (sslength aLo))
       (while(>=(setq n(1- n)) 0) (redraw(ssname aLo n) 3))
       (command "_.bpoly" "A" "B" "N" aLo "" "" PnT "")
       (setq Bnd (vlax-ename->vla-object (entlast))
             oID (itoa(vla-get-ObjectID Bnd)) aLn(vlax-get-property Bnd 'Area))
       (command "_.DrawOrder" "l" "" "f")(redraw (setq Bnd (entlast)) 3)
       (if (setq LyR (entsel (strcat "\rLayer değiştirmek için Obje seçiniz: <"
                            (getvar "CLayer") ">")))
         (setvar "clayer" (cdr (assoc 8 (entget (car LyR))))))
       (vlax-put-property (vlax-ename->vla-object Bnd) 'Layer(getvar "CLayer"))
       (redraw (setq Bnd (entlast)) 3)
       (entmake (list '(0 . "Text") '(10 0 0 0) (cons 40 (getvar "TextSize"))
                      (cons 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " oID
                      ">%).Area \\f \"%lu2%pr" (itoa(getvar "Luprec")) "\">%"))
                      '(50 . 0.0) '(72 . 1) '(11 0 0 0)))
       (command "_.UpDateField" (entlast) "")
       (setq dro (vlax-ename->vla-object (setq so (entlast))) sp0 '(0 0 0))
       (while (and (/= 3 (car (setq sp (grread T 4 2)))) (/= (car sp) 25))
         (if a (redraw (ssname a 0) 4)) (vla-transformby dro (vlax-tmatrix
                (list (list 1 0 0 (- (car (cadr sp)) (car sp0)))
                (list 0 1 0 (- (cadr (cadr sp)) (cadr sp0)))
                (list 0 0 1 (- (caddr (cadr sp)) (caddr sp0)))(list 0 0 0 1))))
         (setq sp0 (cadr sp)) (entdel so)
         (if (setq a (ssget sp0 (list '(0 . "*Text")))) (redraw(ssname a 0) 3))
         (entdel so))(if (= (car sp) 3)(progn(vla-transformby dro (vlax-tmatrix
          (list (list 1 0 0 (- (car (cadr sp)) (car sp0)))
                (list 0 1 0 (- (cadr (cadr sp)) (cadr sp0)))
                (list 0 0 1 (- (caddr (cadr sp)) (caddr sp0)))(list 0 0 0 1))))
          (entdel so) (if (setq tp (ssget sp0 (list (cons 0 "*Text"))))
            (vlax-put-property(vlax-ename->vla-object(ssname tp 0)) 'TextString
              (rtos aLn 2 (getvar "Luprec"))) (entdel so))) (vla-erase dro))
       (redraw Bnd 4) (setq n(sslength aLo))
       (while(>=(setq n(1- n)) 0)(redraw(ssname aLo n) 3)))
     (if aLo (progn (setq n (sslength aLo))
       (while(>=(setq n (1- n)) 0)(redraw (ssname aLo n) 4)))))
   (if aLo (progn (setq n (sslength aLo))
       (while(>=(setq n (1- n)) 0) (redraw (ssname aLo n) 4))))
   (command "_.undo" "e") (setvar "cmdecho" 1) (prin1))
08.05.2012 08:26    
halilozcakir
merhaba,
çizimde kalem kalınlıkları,
layerda belirtilmiş olan kalınlıktan farklı bir kalınlık olan,
tüm objeleri -özellikle line pline circle arc spline gibi- kalem kalınlığını by layer yapan bir lisp vardı sitede aradım bulamadım?

15.05.2012 12:50    
starkopf
poyline olan bir uzunlugun istenilen yerinden başlangıca olan uzaklıgını kilometre gösterimi cinsinden veren bir autolisp varmıdır.
mevcut olanlar bu polyline uzunlugunu verilen aralıkta kilometre gösterimi şeklinde yapıyor. fakat istenilen yerden vermiyor.

15.05.2012 13:26    
ProhibiT
"Mevcut olanlar" dediklerinizi örneklerseniz, Ya da yapmak istediğinizi resimlerle anlatırsanız, bahsettiğiniz işlem zor bir şey değil.

17.05.2012 11:20    
ProhibiT
İstek üzerine
Kod:

(defun C:PB (/ pn)
;; Tum cizim icinde belirlenen yazilar veya sayilar secilir
   (setvar "cmdecho" 0)  (command "undo" "group")
   (setq pn "" pn (strcase (getstring "\nPoz No: ")))
   (command "select" (ssget "x" (list (cons 1 pn))) "")
   (command "_.Zoom" "O" (ssname pn 0) "")
   (command "undo" "e")  (prin1))

Klavyeden girilen bir Text içeriğini Tüm çizim içinde arayıp bularak, bu objeyi seçer ve o objeye zoom alır.
Uyarı String içinde Sub String bulmaz. Girilen yazı, text içeriğinin tamamı olmalıdır.

17.05.2012 11:55    
Travaci
Eline sağlık teşekkürler

24.05.2012 11:08    
cagrikara
Merhabalar,

3 boyutta spline ile çizilmiş çizgilerin kotlarını belirtilen kota getirilmesi için bir lisp isteyebilirmiyim. Spline sıralı s çizgiler oluşturduğu için 3 boyutta çizilen spline çizgilerinin her noktası aynı kotta olmuyor. bu spline çizgisini seçerek istediğim kodu yazsam ve yine aynı spline da spline'ı oluşturduğum noktaların kotlarını istediğim kota indirse.

Tabi 100 spline da çizsem 100ünüde 1 kalemde istediğim kota indirmek istiyorum.

Yardımlarınız için şimdiden teşekkürler.

28.05.2012 07:58    
ProhibiT
halilozcakir arkadaşımızın isteği üzerine;
Kod:

;|===========================================================================|;
;| LwT2ByL: LineWeight to ByLayer                                            |;
;|          Çizim içindeki, bLock tanımları ve bLock referansları da dahil   |;
;|          tüm çizim objelerinin LineWeight özelliklerini ByLayer yapar.    |;
;|          Author: M. Şahin Güvercin - www.autocadokulu.com - 28.05.2012    |;
;|---------------------------------------------------------------------------|;
(defun c:LwT2ByL  (/ *error* bLk PvT)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (defun *error* (er) (princ (strcat "\n" er)) (setvar "cmdecho" 1)
    (command "_.undo" "end")) (setq bLk (tblnext "bLock" T))
  (while bLK (setq PvT (tblobjname "bLock" (cdr (assoc 2 bLk))))
    (while (setq PvT (entnext PvT)) (vlax-put-property
        (vlax-ename->vla-object PvT) 'Lineweight -1))
    (setq bLk (tblnext "bLock"))) (setq PvT (entnext))
  (while PvT (vlax-put-property (vlax-ename->vla-object PvT) 'Lineweight -1)
    (setq PvT (entnext PvT)))
  (setvar "cmdecho" 1) (command "_.undo" "end") (prin1))
28.05.2012 10:24    
halilozcakir
teşekkür ederim Hocam. mahçup olduk.

28.05.2012 12:34    
ProhibiT
Asla bir mahcubiyet söz konusu olamaz. Doğru istek, doğru şekilde ve doğru zamanda olunca, fazla bir şeye gerek kalmadan, cevabı birlikte buluyoruz.

30.05.2012 08:36    
prgkolik
HOCAM BENİM BİR İSTEĞİM OLACAK

TRİM İLE İLGİLİ


ben bir proje çizdiğimde bana gelen mimarinin bir kısmını almak istiyorum fakat öyle bir yerini isitiyorum ki yukarıdan aşağıya bir çizgi çizip çizginin sağ tarafında bulunan tüm çizimlerin silinmesini istiyorum yada çizdiğim çizgiye temas eden tüm çizgilerin silinmesini istiyorum ( evet sizin düşündüğünüz gibi böyle bir tirim var fakat düz çizgi çizdiğinizde var) ben 45 derece çizgi çizdiğimde bu çizginin değdiği çizgilerin sağ tarafında bulunan yada sol tarafında yada bir ölçü vererek ayırmak istiyoruym mumkün mü ????



ŞİMDİDEN VERMİŞ OLDUĞUNUZ BİLGİLER VE YARDIMCI OLMAK İSTEDİĞİNİZ İÇİN
TEŞEKKÜRLER EDERİM

30.05.2012 10:53    
ProhibiT


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

linkinde paylaşılan fonksiyonu deneyin. İstediğinizden fazlası var. Ya da, AutoCAD Express Tools menüsünden ExTrim fonksiyonunu deneyin.

ProhibiT (30.05.2012 11:03 GMT)

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