17.07.2014 17:39    

alpayelmas
Arkadaslar merhaba x y z koordinatlari satir satir text dosyasinda olan noktalardan ilk 4 satir 4 koseyi ifade eder selde 20 mm kalinlikli plane cizen lisp ihtiyacim var. Bu islemi txt dosya sonuna kadar yapicak. Yardimci olabilirmisiniz
txt
x y z
1 2 3
4 5 6
7 8 9
10 11 12

gibi

21.07.2014 09:28    

ProhibiT
Kod:

(defun C:M3D (/ Dosya myerr p1 p2 p3 p4 Satir)
  (setvar "cmdecho" 0) (command "_.undo" "group")
  (defun myerr  (errmsg /) (if (/= errmsg "Function cancelled")(prompt errmsg))
    (command-s "._undo" "_e") (command-s "._U")
    (setvar "osmode" oosm) (setq *error* olderr) (princ))
  (setq olderr *error* *error* myerr oosm (getvar "osmode")
        Dosya (open (getfiled "Koordinat Dosyası" "" "" 4) "r"))
  (setvar "osmode" 0)
  (while (and Dosya (setq Satir (read-line Dosya)))
    (if (numberp (atof Satir))
      (progn
        (setq p1 (list (read Satir)
               (read (setq Satir (substr (vl-string-position 32 Satir) Satir)))
               (read (substr (vl-string-position 32 Satir) Satir)))
              Satir (read-line Dosya)
              p2 (list (read Satir)
               (read (setq Satir (substr (vl-string-position 32 Satir) Satir)))
               (read (substr (vl-string-position 32 Satir) Satir)))
              Satir (read-line Dosya)
              p3 (list (read Satir)
               (read (setq Satir (substr (vl-string-position 32 Satir) Satir)))
               (read (substr (vl-string-position 32 Satir) Satir)))
              Satir (read-line Dosya)
              p4 (list (read Satir)
               (read (setq Satir (substr (vl-string-position 32 Satir) Satir)))
               (read (substr (vl-string-position 32 Satir) Satir))))
        (command "_.UCS" p4 p3 p1)
        (command "_.Elevation" "0.0")
        (command "_.PLine" (trans (list (car p1) (cadr p1)) 0 1)
                           (trans (list (car p2) (cadr p2)) 0 1)
                           (trans (list (car p3) (cadr p3)) 0 1)
                           (trans (list (car p4) (cadr p4)) 0 1) "c")
        (command "_.Extrude" "l" "" 20)))) (close Dosya)
  (setvar "osmode" oosm)(command "_.undo" "end") (setq *error* olderr) (prin1))

Detaylı deneme test etme fırsatım olmadı, bir deneyin, aksaklıklar varsa düzeltilebilir.

Kolay gelsin.

05.08.2014 14:05    

alpayelmas
teşekkür ederim . Biraz geç oldu ama bayram tatılındeydım . Hemen deniyorum hocam...

18.03.2015 05:15    

cano23
Selam Arkadaslar, Autocad projesi uzerinde MText olarak yazilmis yukseklik degerleri var. Bu objelerin koordinat degerlerini (X,Y) ve iceriklerini excell e gonderebilecegim bir uygulama var mi? Yardimlariniz icin simdiden tesekkurler.

18.03.2015 13:49    

alumina
Alıntı
cano23 :



Kod:

(defun c:tx (/ ss xls so pt)
(vl-load-com)
(defun *error* (msg) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  (princ (strcat "\nError: " msg)) (princ)))
   (if (setq ss (ssget '((0 . "*text"))))
    (progn
     (setq xls (open (getfiled "" "" "xls" 9) "w"))
      (write-line (strcat "String" "\t" "x" "\t" "y") xls)
       (vlax-for so (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
        (setq pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint so)))
        )
         (write-line (strcat (vla-get-TextString so) "\t" (rtos (car pt) 2 2) "\t" (rtos (cadr pt) 2 2)) xls)
       )
(close xls)
    )
   )
(princ)
)

> 1 <
Copyright © 2004-2022 SQL: 0.876 saniye - Sorgu: 54 - Ortalama: 0.01622 saniye