[uamihanik]

Понадобилась программа для вывода в чертёж текста по заданным координатам. Нашел вот такую:

(defun str-str-lst (str pat / i)
;;; (str-str-lst "Столб 401.535 181.548 9.00" " ")
;;; ("Столб" "401.535" "181.548" "9.00")
(cond ((= str "") nil)
((setq i (vl-string-search pat str))
(cons
(substr str 1 i)
(str-str-lst
(vl-string-left-trim pat (substr str (1+ i)))
pat
) ;_ end of str-str-lst
) ;_ cons
)
(t (list str))
) ;_ cond
) ;_ defun

(defun txt2ac (path / coors fn fname ln)
(if (setq fname
(getfiled "Выбрать файл для чтения координат" path "txt" 16)
) ;_ end of setq
(progn
(setq fn (open (findfile fname) "r"))
(while (setq ln (read-line fn))
(setq coors (cons (str-str-lst ln " ") coors))
;;; (setq coors (cons (read (strcat "(" ln ")")) coors))
) ;_ end of while
(close fn)
) ;_ end of progn
) ;_ end of if
(reverse coors)
) ;_ end of defun

(defun C:tac (/ path points r h st sysvar lst)
;;;Создаем слои
(mapcar '(lambda (x y)
(if (not (tblsearch "layer" x))
(entmakex (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 x)
'(70 . 0)
(cons 62 y)
'(6 . "Continuous")
) ;_ end of list
) ;_ end of entmakex
) ;_ end of if
) ;_ end of lambda
'("Точка" "Круг" "NITKA1" "Нумерация" "Bereg") ;имена слоев
'(2 3 1 7 7) ;цвета слоев
) ;_ end of mapcar
;;;задаешь путь поиска текстового файла :
(setq path (getvar "dwgprefix")) ;путь измени на свой
;;; получили точки из текстового файла
(setq points (txt2ac path))
;;; можно их отрисовать :
(setq r (getreal "\nРадиус: "))
(setq h (getreal "\nВысота текста: "))
(setq st (getvar "TEXTSTYLE"))
;;;1. Точки + Круги + Текст
(mapcar '(lambda (x / pt)
(setq pt (mapcar 'read (cdr x)))
(setq lst (cons pt lst))
(entmakex
(list '(0 . "POINT")
(cons 8 "Точка")
(cons 10 pt)
) ;_ end of list
) ;_ end of entmakex
(entmakex
(list '(0 . "CIRCLE")
(cons 8 "Круг")
(cons 10 pt)
(cons 40 r)
) ;_ end of list
) ;_ end of entmakex
(entmakex
(list '(0 . "TEXT")
(cons 8 "Нумерация")
(cons 7 st)
(cons 10 (mapcar '+ pt '(0.0 5.0 0.0)))
;! 5 - отступ вверх на 5мм от точки
(cons 40 h)
(cons 1 (car x))
) ;_ end of list
) ;_ end of entmakex
(entmakex
(list '(0 . "TEXT")
(cons 8 "Отметка")
(cons 7 st)
(cons 10 (mapcar '+ pt '(5.0 0.0 0.0)))
;! 5 - отступ вправо на 5мм от точки
(cons 40 h)
(cons 1 (last x))
) ;_ end of list
) ;_ end of entmakex
) ;_ end of lambda
points
) ;_ end of mapcar
;;;2. Полилинию
(setq sysvar (mapcar 'getvar '("osmode" "cmdecho" "clayer")))
(mapcar 'setvar '("osmode" "cmdecho" "clayer") '(0 0 "Полилиния"))
(command "_3dpoly")

В принципе она меня устраивает, но в ней есть то, что мне не нужно и приходится удалять лишнее вручную. Может Вы смогли бы подправить эту программу (сам, к сожалению, не владею языком) или у Вас есть готовое решение моих просьб: оставить запрос высоты текста, экспорт в чертеж только текста(z) из файла (формат файла: x y z (разделители - пробел)) без кругов, точек и номера. Убрать: запрос радиуса круга, смещение текста,все слои, кроме Отметка.
Спасибо.
С уважением, uamihanik.

[gomer]

Код:

[Выделить все]

 (defun str-str-lst (str pat / i) 
;;; (str-str-lst "Столб 401.535 181.548 9.00" " ") 
;;; ("Столб" "401.535" "181.548" "9.00") 
  (cond ((= str "") nil) 
    ( (setq i (vl-string-search pat str)) 
      (cons 
        (substr str 1 i) 
        (str-str-lst 
          (vl-string-left-trim pat (substr str (1+ i))) 
          pat 
        )
      )
    ) 
    (t (list str)) 
  )
)


(defun txt2ac (path / coors fn fname ln) 
  (if
    (setq
      fname 
      (getfiled "Выбрать файл для чтения координат" path "txt" 16) 
    )
    (progn 
      (setq fn (open (findfile fname) "r")) 
      (while (setq ln (read-line fn)) 
        (setq coors (cons (str-str-lst ln " ") coors)) 
     ;; (setq coors (cons (read (strcat "(" ln ")")) coors)) 
      )
      (close fn) 
    )
  )
  (reverse coors) 
)


(defun C:TAC (/ path points r h st sysvar lst) 

;;;Создаем слои 

  (mapcar
   '(lambda (x y) 
      (if (not (tblsearch "layer" x))
        (entmakex
          (list
           '(0   . "LAYER") 
           '(100 . "AcDbSymbolTableRecord") 
           '(100 . "AcDbLayerTableRecord") 
            (cons 2 x) 
           '(70  . 0) 
            (cons 62 y) 
           '(6   . "Continuous") 
          )
        )
      )
    )
   '("Отметка") ; "Точка" "Круг" "NITKA1" "Нумерация" "Bereg") ;имена слоев 
   '(2 ) ; 3 1 7 7) ;цвета слоев 
  )

;;;задаешь путь поиска текстового файла : 
  (setq path (getvar "dwgprefix")) ;путь измени на свой

;;; получили точки из текстового файла 
  (setq points (txt2ac path))

;;; можно их отрисовать : 
;;;  (setq r  (getreal "\nРадиус: ")) 
  (setq h  (getreal "\nВысота текста: ")) 
  (setq st (getvar "TEXTSTYLE"))

;;; 1. Точки + Круги + Текст 
  (mapcar
   '(lambda (x / pt) 
      (setq pt (mapcar 'read x)) 
   ;; (setq pt (mapcar 'read (cdr x))) 
      (setq lst (cons pt lst)) 
;;;      (entmakex 
;;;        (list
;;;         '(0 . "POINT") 
;;;          (cons 8 "Точка") 
;;;          (cons 10 pt) 
;;;        )
;;;      )
;;;      (entmakex 
;;;        (list
;;;         '(0 . "CIRCLE") 
;;;          (cons 8 "Круг") 
;;;          (cons 10 pt) 
;;;          (cons 40 r) 
;;;        ) 
;;;      )
;;;      (entmakex 
;;;        (list
;;;         '(0 . "TEXT") 
;;;          (cons 8 "Нумерация") 
;;;          (cons 7 st) 
;;;          (cons 10 (mapcar '+ pt '(0.0 5.0 0.0))) ; отступ вверх на 5мм от точки
;;;          (cons 40 h) 
;;;          (cons 1 (car x)) 
;;;        )
;;;      )
      (entmakex 
        (list
         '(0 . "TEXT") 
          (cons 8 "Отметка") 
          (cons 7 st) 
          (cons 10 pt) ; (mapcar '+ pt '(5.0 0.0 0.0))) 
          (cons 40 h) 
          (cons 1 (last x)) 
        )
      )
    )
    points 
  ) 

;;; 2. Полилинию 
  (setq sysvar (mapcar 'getvar '("osmode" "cmdecho" "clayer"))) 
  (mapcar 'setvar '("osmode" "cmdecho" "clayer") '(0 0 "Полилиния")) 
  (command "_.3dpoly")
  ;; ГДЕ???
)

[uamihanik]

В вашем коде учитывается строка "Нумерация" из файла (может я не правильно выражаюсь, но программа работает с файлами с содержанием типа n x y z), а хотелось бы, что-бы программа работала с файлом типа: x y z
Поправьте, пожалуйста

[gomer]

так что ли?

[uamihanik]

Спасибо, теперь всё замечательно, тему можно закрывать

[gomer]

Сообщение от uamihanik Спасибо, теперь всё замечательно, тему можно закрывать

эээ, ну, кагбэ я намекнул, что это кусок программы, вырванный зверски из чего-то большего...

[VVA]

Так, к сведению. Есть еще такая штука
Импорт координат из текстовых файлов форматов txt, sdr, csv и других в AutoCAD

[uamihanik]

Сообщение от VVA Так, к сведению. Есть еще такая штука Импорт координат из текстовых файлов форматов txt, sdr, csv и других в AutoCAD

Спасибо за подсказку, попробовал, как-то много ненужных мне опций (хотя кому-то это действительно подходящая программа), вот вариант выше более лаконичен, а иногда приходится закидывать кучу текста и тут уже скорость на первом месте. Еще раз всем спасибо.