Страница 1 от 1

AutoLISP: извличане на точки във файл

Публикувано на: Вто Фев 12, 2008 1:09 pm
от g_ishkitiev
знам че има много други начини, но все пак реших да кача и този скрипт .
(defun C:GETPNT ()
(setvar "CMDECHO" 0)
(setq fn (getstring "\nEnter output filename: "))
(setq p T pl ())
(while p (progn
(command "OSNAP" "NOD")
(setq p (entsel "\nSelect a point to save: "))
(command "OSNAP" "NON")
(if p (progn
(setq e (entget (car p)))
(if (= (cdr (assoc 0 e)) "POINT") (progn
(setq p (assoc 10 e) y (cadr p) x (caddr p) z (cadddr p))
(setq p (entsel "\nSelect point number: "))
(if p (progn
(setq e (entget (car p)))
(if (= (cdr (assoc 0 e)) "TEXT")
(setq n (cdr (assoc 1 e))) (setq n " "))
) (setq n " "))
(while (< (strlen n) 6) (setq n (strcat " " n)))
(setq x (rtos x 2 3) y (rtos y 2 3) z (rtos z 2 3))
(while (< (strlen x) 10) (setq x (strcat " " x)))
(while (< (strlen y) 10) (setq y (strcat " " y)))
(while (< (strlen z) 10) (setq z (strcat " " z)))
(setq s (strcat n "," x "," y "," z))
(princ "\n") (princ s)
(setq pl (cons s pl) p t)
) (princ "\n\nThis is no point !!!"))
))
))
(setq pl (reverse pl))
(setq f (open fn "w"))
(while pl (progn
(setq p (car pl) pl (cdr pl))
(write-line p f)
))
(close f)
)
http://dyp.data.bg/Software/Acad%20tool ... GETPNT.LSP

след като се зареди се стартирва с getpnt след което се посочва името на изходния файл и се селектират последователно точката и номера на точката.

Публикувано на: Чет Апр 10, 2008 8:13 pm
от R
(defun C:OUT ( / a c d e h i f s x y z re zk br cd ex)
(if (not nprfile) (setq nprfile ""))
(setq s (getfiled "Save file" nprfile "txt" 1))
(if (not s) (quit))

(setq f (open s "w"))

(initget 7)
(setq i (getint "\nÍà÷àëåí íîìåð:"))
(initget "y n")
(setq re (getkword "\nÐàçìÿíà íà X è Y? <y/n>:"))
(initget "y n")
(setq zk (getkword "\nZ Êîîðäèíàòà? <y/n>:"))
(initget (+ 1 4))
(setq br (getint "\nÁðîé öèôðè ñëåä çàïåòàÿòà:"))
(setq cd (getstring "\nÊîä íà òî÷êàòà:"))

(setq a (getpoint "\nÒî÷êà:"))

(while (/= a nil)

(setq x (car a))
(setq y (cadr a))
(setq z (caddr a))


(setq c (rtos x 2 br))
(setq d (rtos y 2 br))
(setq h (rtos z 2 br))



(if (= re "y")

(if (= zk "y") (setq e (strcat (rtos i 2 0) " " d " " c " " h " " cd)) ;if (= re "y") and (= zk "y")
(setq e (strcat (rtos i 2 0) " " d " " c " " cd))) ;if (= re "y") and (/= zk "y")

(if (= zk "y") (setq e (strcat (rtos i 2 0) " " c " " d " " h " " cd));if (/= re "y") and (= zk "y")
(setq e (strcat (rtos i 2 0) " " c " " d " " cd))) ;if (/= re "y") and (/= zk "y")
);if


(setq i (+ i 1))
(write-line e)
(write-line e f)

(setq a (getpoint "\nÒî÷êà:"))

);end while

(close f)
);end