Тема: LISP. Рисование точек с номерами по координатам из внешнего файла
Задача: Есть текстовый файл со списком координат (координаты могут быть как X,Y, так и X,Y,Z). Необходимо нарисовать точки с заданными координатами + проставить номера этих точек (первая координаты в списке - 1, вторые - 2 и т.д.)
Вариант использования: Можно быстро занести результаты полевых геодезических съемок в Акад.
Написал прогу kpblc
;; Сохранение состояния системных переменных
(defun lib:error-save-sysvar (sysvar-list)
(foreach item sysvar-list
(setq *kpblc-sysvar-list*
(cons
(list (car item) (getvar (car item)))
*kpblc-sysvar-list*
) ;_ end of cons
) ;_ end of setq
(if (cadr item) ; передано устанавливаемое значение
(setvar (car item) (cadr item))
) ;_ end of if
) ;_ end of foreach
) ;_ end of defun
;; Восстановление состояния системных переменных
(defun lib:error-restore-sysvar ()
(if *kpblc-sysvar-list*
(foreach item *kpblc-sysvar-list*
(setvar (car item) (cadr item))
) ;_ end of foreach
) ;_ end of if
(setq *kpblc-sysvar-list* nil)
(princ)
) ;_ end of defun
;; получение координат точек. Возвращает список координат
(defun lib:point-get-coord (string / x y z)
(setq x (atof (substr string 1 (vl-string-search "," string)))
string (substr string (+ 2 (vl-string-search "," string)) (strlen string))
y (atof (substr string 1 (vl-string-search "," string)))
) ;_ end of setq
(if (vl-string-search "," string)
(setq z
(atof
(substr string
(+ 2 (vl-string-search "," string))
(strlen string)
) ;_ end of substr
) ;_ end of atof
) ;_ end of setq
(setq z 0.0)
) ;_ end of if
(list x y z)
) ;_ end of defun
;; Получение значения dxf-кода для примитива
(defun lib:ent-get-dxf-data (ent dxf)
(cond
((= (type ent) 'ename) (setq ent (entget ent)))
((= (type ent) 'vla-object) (setq ent (vlax-vla-object->ename ent)))
(t ent)
) ;_ end of cond
(cdr (assoc dxf ent))
) ;_ end of defun
;; Последовательное чтение файла. Возвращает список точек
(defun lib:read-file (file-name / file_handle file_string result)
(if (setq file_handle (open file-name "r"))
(progn
(while (and
(setq file_string (read-line file_handle))
(vl-string-search "," file_string)
) ;_ end of and
(setq file_string (vl-string-trim " " file_string))
(setq result (cons
(lib:point-get-coord file_string)
result
) ;_ end of cons
) ;_ end of setq
) ;_ end of while
) ;_ end of progn
) ;_ end of if
(close file_handle)
(reverse result)
) ;_ end of defun
;; Создание точек
;; Параметры: file-name текстовое имя файла
;; autonum автоматически нумеровать (t) или нет (nil)
;; В случае автоматической нумерации используется выравнивание
(defun _kpblc-make-points (file-name autonum text-height offset
/ point_list counter ent_list
)
(setq point_list
(lib:read-file file-name)
counter 0
) ;_ end of setq
(foreach item point_list
(setq counter (1+ counter))
(command "_.point" item)
(if autonum
(progn ; Ведется автонумерация
(setq ent_list (list (cons 0 "TEXT")
'(100 . "AcDbEntity")
(cons 10
(list (+ offset (car item))
(+ offset (cadr item))
(caddr item)
) ;_ end of list
) ;_ end of cons
(cons 40 text_height)
(cons 1 (itoa counter))
'(100 . "AcDbText")
) ;_ end of list
) ;_ end of setq
(entmake ent_list)
) ;_ end of progn
(progn ; Автонумерации нет
(command "_.dtext")
(while (/= (getvar "cmdactive") 0)
(command pause)
) ;_ end of while
) ;_ end of progn
) ;_ end of if
) ;_ end of foreach
) ;_ end of defun
(defun c:mk-point (/ file_name _answer_ text_height offset)
;; Локальные функции
(defun *error* (msg)
(princ msg)
(lib:error-restore-sysvar)
) ;_ end of defun
;; Конец локальных функций
(lib:error-save-sysvar '(("osmode" 0)))
(setq file_name (getstring "\nВведите имя файла : "))
(initget "Да Нет Yes No _ Yes No Yes No")
(setq _answer_
(getkword "\nВыполнять автоматическую нумерацию [Да/Нет] <Нет>? : "
) ;_ end of getkword
) ;_ end of setq
(setq _answer_ (= _answer_ "Yes"))
(if
(= (lib:ent-get-dxf-data (tblsearch "style" (getvar "textstyle")) 40) 0.0)
(progn
(setq text_height
(getreal "\nВведите высоту текста для нумерации <2.5> : ")
) ;_ end of setq
(if (not text_height)
(setq text_height 2.5)
) ;_ end of if
(setq offset (getreal "\nВведите значение смещения текста <0.0> : "))
(if (not offset)
(setq offset 0.0)
) ;_ end of if
) ;_ end of progn
(setq text_height
(lib:ent-get-dxf-data (tblsearch "style" (getvar "textstyle")) 40)
) ;_ end of setq
) ;_ end of if
(_kpblc-make-points file_name _answer_ text_height offset)
(lib:error-restore-sysvar)
) ;_ end of defun
