AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoLISP > uzunluk lispi ile ilgili
03.07.2008 12:51    
meteyus
aşagıdaki lispte sadece secilen objelerin mesajla uzunlugunu vermektedir. bunu bir objeyı sectıgımızde ıstedıgımız noktaya uzunlugunu yazmasını nasıl yapabiliriz. kolay gelsin



(defun c:uo ()
(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 "\nToplam Uzunluk: " (rtos (/ toplami 100) 2 2)" metre"))

)
)
(princ)
)

03.07.2008 13:05    
ehya
müsait bir zamanda eklerim..
ya da vakti olan bir arkadaş eklerse o da olur..

03.07.2008 13:26    
meteyus
teşekkürler ehya kardeş

03.07.2008 13:31    
Harbi65
Nesne seçtikten sonra nokta gösterdiğin yere yazar. Nokta göstermez Enterla geçersen önce ki gibi sadece ekranda gösterir... Umarım istediğin gibi olmuştur.

Kod:

(defun c:uo ()
  ;(setvar "modemacro" "Archme Design by --> EhYa <--")
  (vl-load-com)
  (setq yaz_yk 15.0)
  (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))
      )
      (setq yz_nkt (getpoint "\n Yazının yerleşeceği noktayı gösterin:"))
      (if (= yz_nkt nil)
(progn
  (alert (strcat "\nToplam Uzunluk: "
(rtos (/ toplami 100) 2 2)
" metre"
)
)
  )
(progn  
  (command "_text" "_st" "standard" "j" "_mc" yz_nkt yaz_yk 0 (strcat (rtos (/ toplami 100) 2 2) " metre"))

  )
)

    )
  )
  (princ)
)
03.07.2008 13:38    
meteyus
teşekkürler Harbi65 kardeş çok işime yaradı


Alıntı
Harbi65 :
Nesne seçtikten sonra nokta gösterdiğin yere yazar. Nokta göstermez Enterla geçersen önce ki gibi sadece ekranda gösterir... Umarım istediğin gibi olmuştur.

Kod:

(defun c:uo ()
  ;(setvar "modemacro" "Archme Design by --> EhYa <--")
  (vl-load-com)
  (setq yaz_yk 15.0)
  (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))
      )
      (setq yz_nkt (getpoint "\n Yazının yerleşeceği noktayı gösterin:"))
      (if (= yz_nkt nil)
(progn
  (alert (strcat "\nToplam Uzunluk: "
(rtos (/ toplami 100) 2 2)
" metre"
)
)
  )
(progn  
  (command "_text" "_st" "standard" "j" "_mc" yz_nkt yaz_yk 0 (strcat (rtos (/ toplami 100) 2 2) " metre"))

  )
)

    )
  )
  (princ)
)
04.07.2008 12:47    
simsek77
Eline sağlık kardeş sağolasın. Ellerin dert görmesin. Ehya'ya da teşekkürler. Hazırladığı bu güzel lispler için.

14.07.2008 20:07    
izmank
teşekkürler, elinize sağlık

29.01.2009 09:41    
piksel
Eline sağlık çok güzel omuş bunun toplamının yarısını yazmasını istersek nasıl olcak ??

29.01.2009 09:56    
ehya
toplam sayıyı iyiye böl DDEDIT komutu ile değiştir.

29.01.2009 12:27    
serhatgokhan
Lisp icin tesekkurler...

Soyle bi sey eklenebilir mi:? mesela 1000 mm'lik bir line veya polyline cizip uzunlugunu aldigimizda 10.00 metre? diyor. Bu lisp'e mm, cm, m olarak secenekler eklenebilirmi? yani 1000mm, 100cm, 1m

29.01.2009 13:18    
ehya
iyi de arkadaşlar, bir lispi kaç kişi kodlayabilirim. Genelleme yaparak bir lisp yazdım. Burada herkes için kodlamayı değiştirsem işlevi aynı yazılışı farklı bin çeşit lisp çıkar. Eee accık da bana acıyın...

29.01.2009 13:25    
serhatgokhan
Dogru soyluyorsun, haklisin ehya ))

07.05.2009 08:17    
veli87
ben bu uzunluğu attribute blok içine yazmasını istiyorum daha sonra excelle atmak için şimdiden teşekkürler.

08.05.2009 20:21    
hasansar81
valla guzel olmus harbi65 insanlarin cok isine yariyacak birde ekrana gelen kutucuk dahada profesyonel olmus

08.05.2010 08:51    
mustafa uysal
kolay gelsin arkadaşlar birisi bana bu toplam metraj lipsinin komutunu söleyebilirmi

21.02.2017 08:57    
Travaci
Alumina


Oldumu gönlün : )

Kod:

(defun c:Boy (/ os tp ad) (vl-load-com)
  (if (and (ssget (list (cons 0 "*Line,Arc,Ellipse,Spline,Circle")))
        (setq tp 0 ad (vla-get-activedocument (vlax-get-acad-object))))
    (progn
      (vlax-for os (setq ss (vla-get-activeselectionset ad))
        (setq tp (+ tp (vlax-curve-getDistAtParam os (vlax-curve-getEndParam os)))))
      (vla-delete ss) (prompt (rtos tp 2 2)) (alert (rtos tp 2 2))  
    )
  ) (princ)
)
21.02.2017 09:32    
alumina
Alıntı
Travaci :


oldu evet :)

birde "ssget" in ici degiskenden etkilenmediginde "list" ve "cons" kullanmasan sanki daha cok gonlum olacak :)

Kod:

(ssget '((0 . "line,arc")))
21.02.2017 09:48    
Travaci
Kod:

alumina

Olmaz bunlar benim çizgilerim. :pkak

21.02.2017 12:48    
alumina
Alıntı
Travaci :

Haklisin. Ayni seyleri yazma aliskanligindan bile zor vazgecmistin. Neyse bu da oturur zamanla :)

Kod:

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
.
.
.
.
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
22.12.2017 20:28    
ebasalih44
Alıntı
Harbi65 :
Nesne seçtikten sonra nokta gösterdiğin yere yazar. Nokta göstermez Enterla geçersen önce ki gibi sadece ekranda gösterir... Umarım istediğin gibi olmuştur.

Kod:

(defun c:uo ()
  ;(setvar "modemacro" "Archme Design by --> EhYa <--")
  (vl-load-com)
  (setq yaz_yk 15.0)
  (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))
      )
      (setq yz_nkt (getpoint "\n Yazının yerleşeceği noktayı gösterin:"))
      (if (= yz_nkt nil)
(progn
  (alert (strcat "\nToplam Uzunluk: "
(rtos (/ toplami 100) 2 2)
" metre"
)
)
  )
(progn  
  (command "_text" "_st" "standard" "j" "_mc" yz_nkt yaz_yk 0 (strcat (rtos (/ toplami 100) 2 2) " metre"))

  )
)

    )
  )
  (princ)
)
> 1 < [2] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.548 saniye - Sorgu: 101 - Ortalama: 0.01532 saniye