Re: Как из файла выбрать данные с координатами, соединить их линиями и повторить это для всей папки?
Вот пример с данными.
Предположения.
В 1-м файле описан 1 участок, судя по mid (за исключением NB-смежники).Все данные записываются в словарь примитива в виде SC="0000040" как (("SC" "0000040") ...)
Надергать нужное не составит труда. Надо указать какие поля и в каком порядке расположить.
Написаны 2 команды IP- рисует участки OD- выводит объектные данные
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Функция вызывает окно выбора папки
;;;
;;;Аргументы — нет
;;;Возвращаемое значение — путь к папке вида:
;;;disc:\\dir1\\....\\dirN
;;;
;;;Вызов (BrowseFolder)
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun BrowseFolder ( / ShlObj Folder FldObj OutVal)
(vl-load-com)
(setq
ShlObj (vla-getInterfaceObject
(vlax-get-acad-object)
"Shell.Application"
)
Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 "Укажите каталог с файлами *.in4" 0)
)
(vlax-release-object ShlObj)
(if Folder
(progn
(setq
FldObj (vlax-get-property Folder 'Self)
OutVal (vlax-get-property FldObj 'Path)
)
(vlax-release-object Folder)
(vlax-release-object FldObj)
OutVal
)
)
)
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
str - строка для разбора [STRING]
pat - разделитель [STRING]
* Пример запуска
(setq str "мы;изучаем;рекурсии" pat ";")
(setq str "мы — изучаем — рекурсии" pat " — ")
(str-str-lst str pat)
* Читать подробнее https://www.caduser.ru/forum/topic25197.html
|;
(defun str-str-lst (str pat / i)
(cond ((= str "") nil)
((setq i (vl-string-search pat str))
(cons (substr str 1 i)
(str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
) ;_ cons
)
(t (list str))
) ;_ cond
) ;_ defun
(defun c:ip
(/ dir_path files_list item string_list file_handle string str_list count rd_list buf_list)
(vl-load-com)
(setvar "EXTNAMES" 1)
(if (not *kpblc-activedoc*)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of if
(vla-startundomark *kpblc-activedoc*)
(if
(setq dir_path (BrowseFolder))
(if (and (setq files_list (z-files-in-directory dir_path "*.in4" nil))
(> (length files_list) 0)
) ;_ end of and
(progn
(foreach item files_list
(setq file_handle
(open item "r")
string_list nil
rd_list nil
buf_list nil
) ;_ end of setq
(while (setq string (read-line file_handle))
(setq str_list nil)
(cond ((= (substr string 1 1) "#") nil)
((/= (substr string 1 2) "N=") ;_даннне типа AD=
(setq buf_list (append buf_list (list string)))
)
((and (= (substr string 1 2) "N=")
(vl-string-search "X=" string)
(vl-string-search "Y=" string)
)
(setq str_list (append str_list (list string)))
(while (and
(setq string (read-line file_handle))
(= (substr string 1 2) "N=")
(vl-string-search "X=" string)
(vl-string-search "Y=" string)
)
(setq str_list (append str_list (list string)))
)
(setq string_list (append string_list (list str_list))
rd_list (append rd_list (list buf_list))
buf_list (list string)
)
)
)
) ;_ end of while
(close file_handle)
;; Теперь для данного файла получен список строк с координатами
;; точек
;; Надо в первую очередь создать слой. Имя слоя = имени файла (без
;; пути и
;; расширения)
(if (snvalid (vl-filename-base item))
(progn
(vla-add (vla-get-layers *kpblc-activedoc*) (vl-filename-base item))
(vla-put-activelayer
*kpblc-activedoc*
(vla-item (vla-get-layers *kpblc-activedoc*)
(vl-filename-base item)
) ;_ end of vla-item
) ;_ end of vla-put-ActiveLayer
)
);_if
(setq rd_list
(mapcar
'(lambda (r1)
(mapcar
'(lambda (s)
(mapcar '(lambda (s1) (vl-string-trim " " s1))
(str-str-lst (vl-string-translate "\"," " " s) "=")
)
)
r1
)
)
rd_list
))
;(setq RR rd_list SS string_list)
(setq buf_list (vl-remove-if 'null (mapcar '(lambda (r1 s1)(if (assoc "NB" r1) nil (list r1 s1))) rd_list string_list)))
(setq str_list (list(cadar buf_list)))
(setq buf_list (list(apply 'append (mapcar '(lambda (s)(car s)) buf_list))))
(setq count 0)
(foreach item rd_list
(if (assoc "NB" item)
(progn
(setq buf_list (append buf_list (list item))
str_list (append str_list (list (nth count string_list)))
)
)
)
(setq count (1+ count))
)
(mapcar '(lambda (s rd)
(command "_.pline")
(foreach str_item s
(command
(list
(atof
(substr
(substr str_item (+ 3 (vl-string-search "Y=" str_item)))
1
(vl-string-search
","
(substr str_item (+ 3 (vl-string-search "Y=" str_item)))
) ;_ end of VL-STRING-SEARCH
) ;_ end of substr
) ;_ end of atof
(atof
(substr
(substr str_item (+ 3 (vl-string-search "X=" str_item)))
1
(vl-string-search
","
(substr str_item (+ 3 (vl-string-search "X=" str_item)))
) ;_ end of VL-STRING-SEARCH
) ;_ end of substr
) ;_ end of atof
) ;_ end of list
) ;_ end of command
) ;_ end of foreach
(command "_close")
(vlax-ldata-put (entlast) "TEST" rd)
)
str_list
buf_list
)
) ;_ end of foreach
) ;_ end of progn
) ;_ end of if
) ;_ end of if
(vla-endundomark *kpblc-activedoc*)
) ;_ end of defun
(defun C:OD ( / rd el )
(if (and
(setq el (car(entsel "\nВыберите объект")))
(setq rd (vlax-ldata-get el "TEST"))
)
(progn
(princ "\n============== Объектные данные =================\n")
(mapcar '(lambda (s)(terpri)(princ (car s))(princ "=")(princ (cadr s))) rd)
(princ "\n============== Конец Объектные данные =================")
(textscr)
)
(alert "Нет данных")
)
(princ)
)
(princ "\nНаберите IP - вставка данных *.in4 \n OD - просмотр объектных данных")
;|=======================================================================================
* функция z-files-in-directory возвращает список файлов находящаяся в заданной
* директории
* Автор : Зуенко Виталий (ZZZ)
* Параметры:
* directory путь к папке например "D:\\Мои документы\\ZEF\\Lisp"
* pattern шаблон например "*.lsp" или список '("*.dwg" "*.dxf")
* nested искать в вложенных папках: t (да) или nil (нет)
* Пример вызова:
(z-files-in-directory "D:\\Мои документы\\ZEF\\Lisp" "*.lsp" t)
(z-files-in-directory "D:\\Мои документы\\ZEF\\Lisp" '("*.lsp" "*.fas") t)
=======================================================================================|;
(defun z-files-in-directory (directory pattern nested /)
(if (not (listp pattern))
(setq pattern (list pattern))
) ;_ if
(if nested
(apply
'append
(append
(mapcar '(lambda (_pattern)
(mapcar '(lambda (f) (strcat directory "\\" f))
(vl-directory-files directory _pattern 1)
) ;_ list
) ;_ lambda
pattern
) ;_ mapcar
(mapcar
'(lambda (d)
(z-files-in-directory
(strcat directory "\\" d)
pattern
nested
) ;_ z-files-in-directory
) ;_ lambda
(vl-remove
"."
(vl-remove ".."
(vl-directory-files directory nil -1)
) ;_ end of vl-remove
) ;_ vl-remove
) ;_ mapcar
) ;_ append
) ;_ append
(apply
'append
(mapcar '(lambda (_pattern)
(mapcar '(lambda (f) (strcat directory "\\" f))
(vl-directory-files directory _pattern 1)
) ;_ list
) ;_ lambda
pattern
) ;_ mapcar
) ;_ apply
) ;_ if
) ;_ defun
