07.12.2012 15:49    

Aegrine
Sanırım problem şu dosyayı yeniden kaydettim. Lisp dosyasını.. ancak text olduğu için lineları seçemiyorum:(
CL yaptım o zaman da Select obj diyor ama lineları seçince;
Select target entity/Type <.> for current linetype or <RETURN> to enter ibaresi çıkıyor.

linetype: +
dediğimde invalid diyor yine.. :(

07.12.2012 15:52    

Travaci
Lisp'in kısayolunu değiştirin tekrar deneyin.

07.12.2012 17:11    

given
Alıntı
ProhibiT :
Söz verdiğim bir fonksiyon için ancak vakit bulabildim. Seçilen 2 obje ortasında eksen çizgisi (Center Line) oluşturan fonksiyon.
Kod:

;|***************************************************************************|
| cLn: Create Center Line of selected two objects                           |
|      Author: M. Şahin Güvercin  www.cizimokulu.com  04.12.2012            |
|---------------------------------------------------------------------------|;
(defun c:cLn (/ cPt dPt fOb oOd p1 p2 rPt sOb)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (redraw (setq fOb (car (entsel "\n Select First Object: "))) 3)
  (redraw (setq sOb (car (entsel "\nSelect Second Object: "))) 3)
  (if (not (and fOb sOb)) (exit))
  (setq rPt (cdr (assoc 10 (entget fOb)))
        dPt (vlax-curve-getClosestPointTo (vlax-ename->vla-object sOb) rPt T)
        cPt (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) rPt dPt))
  (setq oOd (getvar "OffsetDist")) (setvar "OffsetDist" -1)
  (vl-cmdf "_.Offset" "" (cons fOb (list rPt)) cPt "")
  (setvar "OffsetDist" oOd) (redraw fOb 4) (redraw sOb 4)
  (command "_.undo" "e") (princ))

Seçilen ilk objenin, ikinci seçilen obje ile mesafesi bulunur.
Birinci obje bu mesafenin orta noktasına offset edilir.
İlk seçilen obje, Line, PolyLine, SpLine (gibi adında ..Line.. olan) türü bir obje olmalıdır.
Circle, Arc veya Ellipse seçildiğinde yapılan işlem hatalı olacaktır.
Arc objeleri nden biri Pedit ile işleme alınıp Polyline'a çevrildikten sonra (ilk seçilecek obje Polyline olmak şartıyla) işlem yapılabilir.

Kolay gelsin.




Hocam, elleriniz dert gormesin cok guzel olmus. Yalniz offset yapilan center cizgisinin linetype i center veya dotfix degil. Bu konuda kucuk bir iyilestirme yaparsak tadindan yenmez diyebilirim. Ilginiz icin tesekkur ederim.

07.12.2012 18:40    

Travaci
Bir satır ekleyip aşağıdaki gibi komutu bitirirseniz sizi idare edicektir : ) Mehmet Abi belki farklı bir şekilde yazıcaktır.
Kod:

(command "change" "L" "" "P" "LT" "CENTER" "" )
(command "_.undo" "e") (princ))

08.12.2012 08:10    

given
Alıntı
Travaci :
Bir satır ekleyip aşağıdaki gibi komutu bitirirseniz sizi idare edicektir : ) Mehmet Abi belki farklı bir şekilde yazıcaktır.
Kod:

(command "change" "L" "" "P" "LT" "CENTER" "" )
(command "_.undo" "e") (princ))



Bu ilaveden sonra tam olarak dusundugum lisp seklini aldi. Size ve Mehmet hocama ayri ayri tesekkur ederim.Iyi ki varsiniz.Iyi calismalar,

09.12.2012 14:23    

k005
Merhaba Arkadaşlar;

Aks çizimini lisp ile nasıl yapabilirim..? +
=====================

Layer = Aks

Renk = mavi (Blue)

Linetype = ACAD_ISO10W100

uzunluk = kullanıcıya bağlı

yardımcı arkadaş(a)lara şimdiden teşekkürler..

09.12.2012 16:11    

Travaci
Kod:

(defun c:aKs (/)
   (setvar "cmdecho" 0)(command "undo" "group") (setq oSm (getvar "osmode"))
   (if (not (tblsearch "Layer" "AKS"))
       (command "layer" "N" "AKS" "LT" "ACAD_ISO10W100" "AKS" "C" "5" "AKS" "")
       (princ))
   (setq n1 (getpoint "\rBirinci nokta:") n2 (getpoint n1 "\rİkinci Nokta:"))
   (setvar "osmode" 0)
   (entmake (list (cons 0 "Line") (cons 8 "AKS")
                  (cons 10 n1) (cons 11 n2))) (princ)
   (setvar "osmode" oSm) (command "_.undo" "e") (princ)
)

Travaci (09.12.2012 18:27 GMT)

09.12.2012 16:22    

k005
Alıntı
Travaci :

Hocam, yazmış olduğunuz koda göre, Aksın yarısı olmuş diyebiliriz.. diğer yönde de olması gerekiyor hocam..

********
10 dk dosya eklemeye çalışıyorum siteye unutmuşum... :)

15420-aks.gif

k005 (09.12.2012 16:49 GMT)

09.12.2012 16:30    

Travaci
Nedemek istediğini anlıyamadım !

09.12.2012 16:51    

k005
Alıntı
Travaci :

15420-aks.gif

09.12.2012 17:48    

Travaci
Kod:

(defun c:aKs2 (/)
   (setvar "cmdecho" 0) (command "undo" "group") (setq oSm (getvar "osmode"))
   (setq eCc (getvar "CeCoLor")) (setq eLt (getvar "CelTyPe"))
   (if (not (tblsearch "Layer" "AKS"))
       (command "layer" "N" "AKS" "LT" "ACAD_ISO10W100" "AKS" "C" "5" "AKS" "")
       (princ))
   (if (not eAu) (setq eAu 50))
   (if (setq au (getreal (strcat "\nAks uzunluğu: <" (rtos eAu) "> :")))
   (setq aAu au) (setq au eAu))
   (setq mEs (/ au 2)
         n1 (getpoint "\nYerleştirilece nokta: ")
         p1 (polar n1 0 (- mes)) p2 (polar p1 0 au)
         p3 (polar n1 (-(/ pi 2)) mes) p4 (polar p3 (/ pi 2) au))
   (setvar "osmode" 0)(setvar "CeCoLor" "ByLaYer")(setvar "CelTyPe" "ByLaYer")
   (entmake (list (cons 0 "Line") (cons 8 "AKS")
                  (cons 10 p1) (cons 11 p2))) (princ)
   (entmake (list (cons 0 "Line") (cons 8 "AKS")
                  (cons 10 p3) (cons 11 p4))) (princ)     
   (setvar "osmode" oSm) (setvar "CeCoLor" eCc) (setvar "CelTyPe" eLt)
   (command "_.undo" "e") (princ)
)

10.12.2012 10:10    

k005
Alıntı
Travaci :

Hocam çok teşekkür ediyorum.. eline sağlık.. tamamdır..

10.12.2012 11:26    

Aegrine
Alıntı
Travaci :
Lisp'in kısayolunu değiştirin tekrar deneyin.



Teşekkür ederm iyi çalışmalar

10.12.2012 13:29    

ProhibiT
İlgilenenler için deneysel birçalışma :)
Kod:

;|***************************************************************************|
| Aks: Gelişigüzel düzlem şeklin merkezinden geçen Aksları çizer            |
|              M. Şahin Güvercin  www.cizimokulu.com  10.12.2012            |
|---------------------------------------------------------------------------|;
(defun c:Aks  (/ cTrP MaxP MidP MinP rAng)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (if (not (tblsearch "Ltype" "Aks-MsG"))
    (entmake '((0 . "LTYPE") (100 . "AcDbSymbolTableRecord")
     (100 . "AcDbLinetypeTableRecord") (2 . "Aks-MsG") (70 . 0) (3 . "Aks-MsG")
     (72 . 65) (73 . 5) (40 . 52.50) (49 . 25.0) (74 . 0) (49 . -1.25) (74 . 0)
     (49 . 0.0) (74 . 0) (49 . -1.25) (74 . 0) (49 . 25.0) (74 . 0))))
  (entmake (entget (car (entsel)))) (vl-Cmdf "_.Region" (entlast) "")
  (vla-getboundingbox (vlax-ename->vla-object (entlast)) 'MinP 'MaxP)
  (setq cTrP (vlax-safearray->list (vlax-variant-value (vla-get-centroid
                                          (vlax-ename->vla-object (entlast)))))
        MinP (vlax-safearray->list MinP)
        MaxP (vlax-safearray->list MaxP)
        MidP (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) MinP MaxP)
        rAng (- (angle MinP MaxP))
        cTrP (list (car ctrP) (cadr ctrP) (caddr MinP)))
  (entdel (entlast))
  (entmake (list (cons 0 "Line") (cons 6 "Aks-MsG") (cons 62 1)
                 (cons 10 MinP) (cons 11 MaxP)))
  (vla-transformby (vlax-ename->vla-object (entlast)) (vlax-tmatrix
      (list (list 1 0 0 (- (car cTrP) (car MidP)))
            (list 0 1 0 (- (cadr cTrP) (cadr MidP)))
            (list 0 0 1 (- (caddr cTrP) (caddr MidP)))
            (list 0 0 0 1))))
  (vla-transformby (vlax-ename->vla-object (entlast)) (vlax-tmatrix
      (list (list (cos rAng) (- (sin rAng)) 0 (- (car cTrP)
                     (- (* (car cTrP) (cos rAng)) (* (cadr cTrP) (sin rAng)))))
            (list (sin rAng) (cos rAng) 0 (- (cadr cTrP)
                     (+ (* (car cTrP) (sin rAng)) (* (cadr cTrP) (cos rAng)))))
            (list 0 0 1 0) (list 0 0 0 1)))) (entmake (entget (entlast)))
  (vla-transformby (vlax-ename->vla-object (entlast)) (vlax-tmatrix
      (list (list (cos (/ pi 2.0)) (- (sin (/ pi 2.0))) 0 (- (car cTrP)
         (- (* (car cTrP) (cos (/ pi 2.0))) (* (cadr cTrP) (sin (/ pi 2.0))))))
            (list (sin (/ pi 2.0)) (cos (/ pi 2.0)) 0 (- (cadr cTrP)
         (+ (* (car cTrP) (sin (/ pi 2.0))) (* (cadr cTrP) (cos (/ pi 2.0))))))
            (list 0 0 1 0) (list 0 0 0 1)))) (command "_.undo" "e") (princ))

10.12.2012 14:08    

Travaci
Çok güzel olmuş elinize sağlık, donutlarda da düzgün çalışırsa tadından yenmez : )

10.12.2012 15:09    

ProhibiT
Doughnut'larla da çalışır elbette, lakin aks çizgileri Donut'ın içinde kalır.

Ek açıklama için düzenleme:
Donut komutunu kullanarak bir obje oluşturur bunun List'ini alırsanız, gerçekte bir LWPOLYLINE olduğu görülür. Donut tek segmentli, bu segmenti de Arc olan, LineWidth değerine sahip kapalı bir Polyline'dır. Yukarıdaki örnekte objenin Bounding Box'ı alınırken, LineWidth algılanamadığından bu fonksiyonla çizilen akslar objenin içinde kalacaklardır.

ProhibiT (11.12.2012 07:18 GMT)

11.12.2012 06:10    

k005
Alıntı
ProhibiT :
İlgilenenler için deneysel birçalışma :)
********************************

Çok teşekkürler hocam,, güzel bir çalışma örneği.. özellikle kod içindeki linetype oluşturma,, süper.. bu bir standart sağlayacaktır.. :yes

k005 (11.12.2012 06:22 GMT)

11.12.2012 07:22    

ProhibiT
LineType'ın Load etmeye gerek kalmadan, doğrudan AutoLISP fonksiyon içinden Create edilmesini daha önce örneklerle açıklamıştım. Ama pek kimsenin dikkatini çekmemiştii. :)



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


Kod:

;|***************************************************************************|;
;| LtCrt: LineType Create.                                                   |;
;| Kesik, Aks, Noktali ve Kesciz isimli Çizgi Tiplerini oluşturur.           |;
;| Oluşturulan Çizgi tipleri için, kağıt üzerindeki boyut esas alınmıştır.   |;
;| LtScaLe sistem değişkeni PLot Scale'e eşitlenerek kullanılmalıdır.        |;
;|---------------------------------------------------------------------------|;
(defun c:LtCrt (/)
  (entmake '((0 . "LTYPE") (100 . "AcDbSymbolTableRecord")
   (100 . "AcDbLinetypeTableRecord") (2 . "Kesik") (70 . 0) (3 . "Kesik")
   (72 . 65) (73 . 2) (40 . 3.25) (49 . 2.00) (74 . 0) (49 . -1.25) (74 . 0)))
  (entmake '((0 . "LTYPE") (100 . "AcDbSymbolTableRecord")
   (100 . "AcDbLinetypeTableRecord") (2 . "Aks") (70 . 0) (3 . "Aks")
   (72 . 65) (73 . 5) (40 . 52.50) (49 . 25.0) (74 . 0) (49 . -1.25) (74 . 0)
   (49 . 0.0) (74 . 0) (49 . -1.25) (74 . 0) (49 . 25.0) (74 . 0)))
  (entmake '((0 . "LTYPE") (100 . "AcDbSymbolTableRecord")
   (100 . "AcDbLinetypeTableRecord") (2 . "Noktali") (70 . 0) (3 . "Noktalı")
   (72 . 65) (73 . 2) (40 . 1.0) (49 . 0.0) (74 . 0) (49 . -1.0) (74 . 0)))
  (entmake '((0 . "LTYPE") (100 . "AcDbSymbolTableRecord")
   (100 . "AcDbLinetypeTableRecord") (2 . "Kesit") (70 . 0) (3 . "Kesit")
   (72 . 65) (73 . 7) (40 . 18.0) (49 . 7.125) (74 . 0) (49 . -1.25) (74 . 0)
   (49 . 0.0) (74 . 0) (49 . -1.25) (74 . 0) (49 . 0.0) (74 . 0) (49 . -1.25)
   (74 . 0) (49 . 7.125) '(74 . 0))) (prin1))

ProhibiT (11.12.2012 19:38 GMT)

14.12.2012 16:26    

volkan_25
Kod:

(defun C:sp (/ osm di1 di2 di3 p1 p2)
  (setq osm (getvar "osmode"))
  (if (setq p1  (getpoint "\nFirst point: "))
    (if (setq p2  (getcorner p1 "\nOther point: ")) 
      (progn
        (setq p3 (list (car p1)(cadr p2)))
        (setq p4 (list (car p2)(cadr p1)))
        (setq di1 (distance p1 p4))
        (setq di2 (distance p1 p3))
        (if (< di2 di1)
          (setq di3 di2)
          (setq di3 di1)
        )
        (cond
          ((and (> (car  p1) (car  p2))
                (> (cadr p1) (cadr p2))
            )
            (setq p1 p2))
          ((and (< (car  p1) (car  p2))
                (> (cadr p1) (cadr p2))
            )
            (setq p1 p3))
          ((and (> (car  p1) (car  p2))
                (< (cadr p1) (cadr p2))
            )
            (setq p1 p4))           
        )
        (setq spt (polar p1           0         (/ di3 20)))
        (setq spt (polar spt  (dtr  90)         (/ di3 20)))
        (setq pt1 (polar spt  (dtr  90) (- di2 (/ di3 10))))
        (setq pt2 (polar pt1          0 (- di1 (/ di3 10))))
        (setq pt3 (polar pt1          0         (/ di3  5)))
        (setq pt3 (polar pt3  (dtr 270)         (/ di3  5)))
        (setvar "osmode" 0)
        (command "solid" spt pt1 pt3 pt2 "")
        (setvar "osmode" osm)
      )
    )
  )
  (princ)
)




bu lisp boşluk taraması için bir lisp ama hata vermekte yardımcı olursanız sevinirim

ehya (14.12.2012 16:32 GMT)

14.12.2012 16:33    

ehya
Düzeltilmiş halini aşağıdan alabilirsiniz.

Kod:

(defun C:sp (/ osm di1 di2 di3 p1 p2)
(setq osm (getvar "osmode"))
(if (setq p1 (getpoint "\nFirst point: "))
(if (setq p2 (getcorner p1 "\nOther point: "))
(progn
(setq p3 (list (car p1)(cadr p2)))
(setq p4 (list (car p2)(cadr p1)))
(setq di1 (distance p1 p4))
(setq di2 (distance p1 p3))
(if (< di2 di1)
(setq di3 di2)
(setq di3 di1))
(cond
((and (> (car p1) (car p2))
(> (cadr p1) (cadr p2)))
(setq p1 p2))
((and (< (car p1) (car p2))
(> (cadr p1) (cadr p2))
)(setq p1 p3))
((and (> (car p1) (car p2))
(< (cadr p1) (cadr p2))
)(setq p1 p4))
)(defun dtr ( deg ) (* pi (/ deg 180.0)))
(setq spt (polar p1 0 (/ di3 20)))
(setq spt (polar spt (dtr 90) (/ di3 20)))
(setq pt1 (polar spt (dtr 90) (- di2 (/ di3 10))))
(setq pt2 (polar pt1 0 (- di1 (/ di3 10))))
(setq pt3 (polar pt1 0 (/ di3 5)))
(setq pt3 (polar pt3 (dtr 270) (/ di3 5)))
(setvar "osmode" 0)
(command "solid" spt pt1 pt3 pt2 "")
(setvar "osmode" osm)
)))(princ))

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