08.02.2012 10:09    

cngzklc
Merhaba arkadaşlar,
Seçili Line objelerinin orta noktasına (midpoint'ine), Point (nokta) atan lispe ihtiyacım var. Sitede aradım fakat bulamadım.
Şu an da 100'lerce hatta 1000'lerce çizginin (Line) orta noktasına (midpoint'ine) tek tek Point atmak ile uğraşıyorum. Bu da bayağı bir vaktimi alıyor.
Bu noktaları koordinat almak için kullanacağım.
Yardımcı olabilirseniz sevinirim.
İyi çalışmalar.

08.02.2012 10:35    

ProhibiT
Kod:

;|---------------------------------------------------------------------------|
|        Author: M. Sahin Guvercin 08.02.2012 - www.autocadokulu.com        |;
(defun c:NktL (/ ScSt n Pvt SpT EpT MpT)
  (setvar "cmdecho" 0) (command "undo" "group")
  (while (setq ScSt (ssget ":s" (list (cons 0 "LINE"))))
    (setq  n (sslength ScSt))
    (while (not (minusp (setq n (1- n))))
      (setq Pvt (entget (ssname ScSt n))
            SpT (cdr (assoc 10 Pvt)) EpT (cdr (assoc 11 Pvt))
            MpT (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) SpT EpT))
      (entmake (list (cons 0 "POINT") (cons 10 MpT)))))
  (command "undo" "e") (prin1)
)

ProhibiT (09.02.2012 11:04 GMT)

08.02.2012 11:21    

cngzklc
Şahin Ağabey,
Çok teşekkür ederim. Ellerinize ve emeğinize sağlık. Tam istediğim gibi olmuş. Günlerce uğraştığım işi 5 sn içerisinde yaptım.
İyi çalışmalar.

08.05.2013 16:16    

mukefe71
Selamlar;
Benim nokta atma konusunda şöyle bir lisp ihtiyacım var, yardımcı olursanız sevinirim, çizimimdeki 100 lerce çizginin kesişim noktalarına, yani intersection larına nokta atan lisp lazım. acil yardım lütfen.

08.05.2013 18:12    

Travaci
Kod:

(defun C:PnT (/ Lns m n o p)
   (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com)
   (princ "\nLine Objeleri seçiniz: ")
   (setq Lns (ssget (list (cons 0 "Line"))) m (sslength Lns))
   (while (>= (setq m (1- m)) 1) (setq n m)
      (while (>= (setq p nil n (1- n)) 0)
         (if (not (minusp (vlax-safearray-get-u-bound
         (setq o (vlax-variant-value (vla-intersectwith
         (vlax-ename->vla-object (ssname Lns m))
         (vlax-ename->vla-object (ssname Lns n))                                                            AcExtendNone))) 1)))
         (setq p (vlax-safearray->list o)))
        (if p (entmake (list (cons 0 "POINT") (cons 10 p))))
      )
   )
   (command "undo" "e") (prin1)
)

Kodları Şahin Abi başka bir lispte yazmıştı. Orjinali kesişim noktalarına circle atar.

09.05.2013 06:23    

mukefe71
Hocam çok teşekkür edrim lisp doğru ve çalışıyor. Ancak özür dilerim ben eksik bilgi vermişim galiba. Seçimlerimdeki çizgilerin için pline, arc, sipline ve pedit yaptığım arclarda var. bunlarıda aynı mantıkla saçtirebilirmiyiz. İlginize ve alakanıza teşekkür ederim.

09.05.2013 07:46    

Travaci
Beceremem : )

09.05.2013 07:47    

ozkul
Alıntı
Travaci :
Beceremem : )




-1

09.05.2013 07:51    

Travaci
Ama yukarıdaki kısmı (cons 0 "*Line") bu şekilde yaparsanız plylinelarda da çalışır.

09.05.2013 08:20    

ozkul
Alıntı
Travaci :
Ama yukarıdaki kısmı (cons 0 "*Line") bu şekilde yaparsanız plylinelarda da çalışır.



şimdi +1

09.05.2013 12:46    

mukefe71
Alıntı


Alıntı
--------------------------------------------------------------------------------
Travaci :
Ama yukarıdaki kısmı (cons 0 "*Line") bu şekilde yaparsanız plylinelarda da çalışır.

--------------------------------------------------------------------------------
Alıntı


ozkul:
şimdi +1

+1 de ekledim ama arc ları seçemiyorum.

09.05.2013 12:52    

ozkul
+1 Travaci için. lisp için değil golyat :)

> 1 <
Copyright © 2004-2022 SQL: 1.704 saniye - Sorgu: 76 - Ortalama: 0.02241 saniye