Импорт координат точек из файла съемки тахеометра Trimble M3 в AutoCAD

Red Nova · 24.09.2009, 10:06

Купили пару тахеометров Trimble M3 и столкнулись с тем, что нет с ним софта для импорта координат точек в AutoCAD. В сети покопались, вроде есть для этого TGOffice, попробовал, но толку нет, сплошные ошибки выдает.
В таких случаях невольно вспоминается лисп.
Файл данных имеет расширение .raw но открывается в обычном notepad.
Из всего содержимого файла полезная информация, которая подлежит импорту, содержится только в строках начинающихся на “MP,” либо “CO,Pt”. Если строка начинается на что-либо другое, она не нужна. В первом случае данные следует читать так.
Пример:
MP,7,,10.000,10.000,0.000,S
Точка под номером 7, имеет координаты Х: 10 метров У: 10 метров Z: 0 метров
Во втором случае данные следует читать так.
Пример:
CO,Pt:5 X 0.185 m Y -0.057 m Z 0.019 m
Точка под номером 5, имеет координаты Х : 0.185 метров У : -0.057 метров Z : 0.019 метров

Хотелось бы иметь лисп для импорта таких точки в AutoCAD.
Если кто-то откликнется и захочет помочь, то, вот какие есть пожелания:
1. Для строк начинающихся на “MP,” желательно создать слой “Station” (цвет слоя - красный) а для строк начинающихся на “ CO,Pt” – слой “Points” (цвет слоя - синий)
2. Желательно создать слой “Numbers” в котором будут тексты высотой скажем 100 которые будут содержать номера точек (цвет слоя - желтый). Координаты текстов должны совпадать с координатами точек
3. Координаты точек в файле должны быть в миллиметрах, то есть умножаем координаты из исходного файла на 1000.

Кулик Алексей aka kpblc · 24.09.2009, 10:10

А поискать? Подобных решений на dwg.ru и caduser.ru - воз и маленькая тележка

Red Nova · 24.09.2009, 10:13

Искал но подходящего не нашлось
А хочется чтобы без какого либо редактирования файл импорировать...

Дима_ · 24.09.2009, 11:36

Создай блок с именем "point" c желаемой меткой и запусти "TOREDNOVA":

Код:

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

(vl-load-com)
(defun c:torednova ()
(if (tblsearch "block" "point")
(progn
(vla-startundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
(princ (strcat "Импортированно " (rtos (length
(mapcar '(lambda (point)
(entmakex (list (cons 0 "insert") (cons 66 1) (cons 10 (cdr point)) (cons 2 "POINT")))
(entmakex (list (cons 0 "ATTRIB") (cons 100 "AcDbEntity") (cons 100 "AcDbText")
(cons 10 (cdr point)) (cons 1 (rtos (car point))) (cons 100 "AcDbAttribute") (cons 2 "Number") (cons 70 0)))
(entmakex (list (cons 0 "seqend")))
);end of lambda
(mapcar 'digitextract
(vl-remove-if-not '(lambda (str) (or (= (substr str 1 2) "MP") (= (substr str 1 5) "CO,Pt")))
(readfile (getfiled "Выберите файл с тахеометра" "" "raw" 0)))))
))  " точек."));end of princ&strcat&length&rtos
(vla-endundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
);end of progn
(alert "Не найден блок указателя 'point'")
);end of if
(princ)
);end of torednova

(defun digitextract (str / lstdgt digit char i)
(setq i 1 digit "")
(repeat (strlen str)
(setq char (substr str i 1))
(if 	(and (>= char "0") (<= char "9"))
	(setq digit (strcat digit char))
	(if (= char ".")
	(setq digit (strcat digit "."))
	(if (= digit ".") (setq digit "") 
	(if (/= digit "") (setq lstdgt (append lstdgt (list (atof digit))) digit ""))
)));end of if*3
(setq i (1+ i))
);end of repeat
(if (and (/= digit ".") (/= digit "")) (setq lstdgt (append lstdgt (list (atof digit)))))
lstdgt
);end of digitextract

(defun readfile (F / str lst);возращает список строк файла F
(if F (progn
(setq F (open F "r"))
(if F
(progn
(setq str (read-line F))
(while str (setq lst (append lst (list str)) str (read-line F)))
(close F)
))));end of progn&if*2
lst
);end of readfile

Red Nova · 24.09.2009, 11:42

Пока не получилось

Цитата:

Command:
Command: TOREDNOVA
; error: bad DXF group: (10)

Command:

Дима_ · 24.09.2009, 11:45

скинь конвертируемый файл - скорее всего где-то формат непростой (неописанный) попался
з.ы. с теми что в примере отрабатывал

Red Nova · 24.09.2009, 11:46

Смотри пост #1 в аттаче

Дима_ · 24.09.2009, 11:57

Точки начинаються не на MP;CO, а на MP;CO,Pt - там на CO еще черт знает что начинается. Исправил в #4.
p.s. сейчас прочитал в 1 посте добавку "хотелось бы..." ну чтож, наверное надо было раньше - надумаешь исправлять - лисп ты знаешь.

Red Nova · 24.09.2009, 12:10

Сорри, я должен был так и написать "CO,Pt" ане "CO,"
За код спасибо, работает.
А можно модифицировать в соответствии с пожеланиями на #1? А-то только один слой, да и точки в блоках с атрибутами. Неудобно обрабатывать.

Дима_ · 24.09.2009, 12:15

Блоки вобще нужны или только тексты? Вобщем напиши заново и подробно - больше всего не люблю переправлять.

VVA · 24.09.2009, 12:54

Немного измененный код Димы

Код:

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

(defun c:torednova ()
  (vl-load-com)
  (setvar "PDMODE" 35)
  (setvar "PDSIZE" 50)
  (setq
    lst	(readfile (getfiled "Выберите файл с тахеометра" "" "raw" 0)
	) ;_ end of readfile
  ) ;_ end of setq
  (setq	mp-list	(mapcar	'digitextract
			(vl-remove-if-not
			  '(lambda (str) (= (substr str 1 2) "MP"))
			  lst
			) ;_ end of vl-remove-if-not
		) ;_ end of mapcar
  ) ;_ end of setq
  (setq	co-list	(mapcar	'digitextract
			(vl-remove-if-not
			  '(lambda (str) (= (substr str 1 5) "CO,Pt"))
			  lst
			) ;_ end of vl-remove-if-not
		) ;_ end of mapcar
  ) ;_ end of setq
  (mapcar '(lambda (dat / i)
	     (setq i   (itoa (fix (car dat)))
		   dat (mapcar '* (cdr dat) '(1000. 1000. 1000.))
	     ) ;_ end of setq
	     (entmakex
	       (list (cons 0 "point")
		     (cons 10 dat)
		     (cons 8 "Station")
	       ) ;_ end of list
	     ) ;_ end of entmakex
	     (entmakex
	       (list '(0 . "TEXT")
		     '(100 . "AcDbEntity")
		     '(100 . "AcDbText")
		     (cons 10 dat)
		     (cons 1 i)
		     (cons 40 100) ;_Высота
		     (cons 7 (getvar "TEXTSTYLE"))
		     (cons 72 0)
		     (cons 50 0)
		     (cons 11 dat)
		     (cons 8 "Numbers")
	       ) ;_ end of list
	     ) ;_ end of entmakex

	   ) ;_ end of lambda
	  mp-list
  ) ;_ end of mapcar
  (mapcar '(lambda (dat / i)
	     (setq i   (itoa (fix (car dat)))
		   dat (mapcar '* (cdr dat) '(1000. 1000. 1000.))
	     ) ;_ end of setq
	     (entmakex
	       (list (cons 0 "point")
		     (cons 10 dat)
		     (cons 8 "Points")
	       ) ;_ end of list
	     ) ;_ end of entmakex
	     (entmakex
	       (list '(0 . "TEXT")
		     '(100 . "AcDbEntity")
		     '(100 . "AcDbText")
		     (cons 10 dat)
		     (cons 1 i)
		     (cons 40 100) ;_Высота
		     (cons 7 (getvar "TEXTSTYLE"))
		     (cons 72 0)
		     (cons 50 0)
		     (cons 11 dat)
		     (cons 8 "Numbers")
	       ) ;_ end of list
	     ) ;_ end of entmakex

	   ) ;_ end of lambda
	  co-list
  ) ;_ end of mapcar
  (princ)
) ;_ end of defun

(defun digitextract (str / lstdgt digit char i Flag)
  (setq	i 1
	digit ""
	lstdgt nil
  ) ;_ end of setq
  (repeat (strlen str)
    (setq char (substr str i 1))
    (cond ((= char "-")(setq digit (strcat digit "-") flag nil))
	  ((and (>= char "0") (<= char "9"))
	   (setq digit (strcat digit char) flag nil)
	   )
	  ((= char ".")(setq digit (strcat digit ".") flag nil))
	  (T (setq flag t)
	   )
	  )
    (if (and flag (not (member digit '("" "." "-"))))
        (setq lstdgt (append lstdgt (list (atof digit))) digit "")
      )
    (setq i (1+ i))
  ) ;_ end of repeat
  (if (and (/= digit ".") (/= digit ""))
    (setq lstdgt (append lstdgt (list (atof digit))))
  ) ;_ end of if
  lstdgt
) ;_ end of defun

(defun readfile	(F / str lst)
  (if F
    (progn
      (setq F (open F "r"))
      (if F
	(progn
	  (setq str (read-line F))
	  (while str
	    (setq lst (append lst (list str))
		  str (read-line F)
	    ) ;_ end of setq
	  ) ;_ end of while
	  (close F)
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  lst
) ;_ end of defun

Кулик Алексей aka kpblc · 24.09.2009, 13:10

Что значит у начальства застрять...

Код:

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

(defun entitites (/		      adoc
		  layers	      *error*
		  fun_creale-layer    _kpblc-conv-string-to-list
		  _kpblc-string-replace-noreg
		  file		      handle
		  str		      lst
		 )

  (defun _kpblc-string-replace-noreg (str old new / pos)
    (while
      (and (setq pos (vl-string-search (strcase old) (strcase str)))
	   (not (vl-string-search (strcase new) (strcase str)))
      ) ;_ end of and
       (setq str (strcat (substr str 1 pos)
			 new
			 (_kpblc-string-replace-noreg
			   (substr str (+ (strlen old) pos 1))
			   old
			   new
			 ) ;_ end of _kpblc-string-replace-noreg
		 ) ;_ end of strcat
       ) ;_ end of setq
    ) ;_ end of while
    str
  ) ;_ end of defun

  (defun _kpblc-conv-string-to-list (string separator / i)
    (cond
      ((= string "") nil)
      ((setq i (vl-string-search separator string))
       (cons (substr string 1 i)
	     (_kpblc-conv-string-to-list
	       (substr string (+ (strlen separator) 1 i))
	       separator
	     ) ;_ end of _kpblc-conv-string-to-list
       ) ;_ end of cons
      )
      (t (list string))
    ) ;_ end of cond
  ) ;_ end of defun

  (defun *error* (msg)
    (vl-catch-all-apply (function (lambda () (close handle))))
    (vla-endundomark adoc)
    (princ msg)
    (princ)
  ) ;_ end of defun

  (defun fun_creale-layer (lst / res)
			  ;|
lst :
	'(("name" . <>)
	  ("color" . <>))
|;
    (if	(vl-catch-all-error-p
	  (vl-catch-all-apply
	    (function
	      (lambda ()
		(setq res (vla-item layers (cdr (assoc "name" lst))))
	      )
	    )
	  )
	) ;_ end of vl-catch-all-error-p
      (setq res (vla-add layers (cdr (assoc "name" lst))))
    ) ;_ end of if
    (vla-put-color res (cdr (assoc "color" lst)))
    res
  ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  )
  (if (and (setq file (getfiled "RAW-file" "" "raw" 4))
	   (/= file "")
	   (findfile file)
      ) ;_ end of and
    (progn
      (setq handle (open file "r"))
      (while (setq str (read-line handle))
	(if (wcmatch (strcase str) "MP*,CO*X*Y*Z*")
	  (setq lst (cons str lst))
	) ;_ end of if
      ) ;_ end of while
      (close handle)
      (setq lst	   (reverse lst)
	    layers (vla-get-layers adoc)
      ) ;_ end of setq
      (foreach item '((("name" . "Station") ("color" . 1))
		      (("name" . "Points") ("color" . 5))
		      (("name" . "Numbers") ("color" . 2))
		     )
	(fun_creale-layer item)
      ) ;_ end of foreach
      (foreach item lst
	(setq
	  str (mapcar
		(function
		  (lambda (x)
		    (if	(= (itoa (atoi x)) x)
		      x
		      (* (atof x) 1000.)
		    ) ;_ end of if
		  ) ;_ end of lambda
		) ;_ end of function
		(vl-remove-if-not
		  (function
		    (lambda (x)
		      (wcmatch x "*[0-9]*")
		    ) ;_ end of lambda
		  ) ;_ end of function
		  (cond
		    ((wcmatch (strcase item) "CO*")
		     (apply
		       (function append)
		       (mapcar
			 (function
			   (lambda (x)
			     (_kpblc-conv-string-to-list x ":")
			   )
			 ) ;_ end of function
			 (_kpblc-conv-string-to-list item " ")
		       ) ;_ end of mapcar
		     ) ;_ end of apply
		    )
		    ((wcmatch (strcase item) "MP*")
		     (_kpblc-conv-string-to-list item ",")
		    )
		  ) ;_ end of cond
		) ;_ end of vl-remove-if-not
	      ) ;_ end of mapcar
	) ;_ end of setq
	(entmakex (list	'(0 . "POINT")
			(cons 8
			      (if
				(wcmatch item "MP*")
				 "Station"
				 "Points"
			      ) ;_ end of if
			) ;_ end of cons
			(cons 10 (cdr str))
		  ) ;_ end of list
	) ;_ end of entmakex
	(entmakex (list	'(0 . "TEXT")
			'(100 . "AcDbEntity")
			'(100 . "AcDbText")
			(cons 10 (cdr str))
			(cons 1 (car str))
			(cons 40 100) ;_A^u^n~i^o`a`
			(cons 7 (getvar "TEXTSTYLE"))
			(cons 72 0)
			(cons 50 0)
			(cons 11 (cdr str))
			(cons 8 "Numbers")
		  ) ;_ end of list
	) ;_ end of entmakex
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
) ;_ end of defun

Дима_ · 24.09.2009, 13:13

То VVA - я не хочу переделывать не из врожденной вредности - а из-за предвидения следующей темы - "Как автоматизировать подсчет точек и экспорт их в ..." или "Как по точкам полученным из тахеометра провести полилинии ..." и опять все по новой - причем вины Red Nov'ы в этом нет, еслиб он это осозновал - то сам бы себе мог написать (второе на самом деле намного проще) - что потом делать с этими точками и текстами, как их отличить и пр. Убрать атрибуты (блоки) и поставить вместо них точки дело 3-5 минут, да и все заново переписать - 15. Просто зачем? Будет ясное задание - код навоять дело десятое и простое.
p.s. Крыс - тебя никак начальство по DOS заставило писать?

Кулик Алексей aka kpblc · 24.09.2009, 13:28

Е-мое! Опять кодировка слетела! Ладно, она там только для комментариев нужна, а это некритично

S_Misha · 24.09.2009, 13:41

переключите тримбл на формат M5 а затем TGO

Red Nova · 24.09.2009, 13:57

Дима_,

Цитата:

Блоки вобще нужны или только тексты? Вобщем напиши заново и подробно - больше всего не люблю переправлять.

Нужны тексты. Блоков не надо.
Для каждого вида точек свой цвет, свой слой. + слой для текстов.

VVA,
Близко, но

координаты с минусом некорректны
не все координаты умножились на 1000
точка 8 не умножилась а 4 умножилась.

kpblc,

С координатами что-то не так.

CO,Pt:4 X 0.163 m Y -0.071 m Z 0.018 m
А твоим файлом 4-я точка имеет координаты
0.163 0.018 0.000
координаты с минусом некорректны

ну и надо бы на 1000 умножить чтобы перейти в мм.

S_Misha, Пробовал, координаты переводятся только до того момента как точку станции не поменяешь, остальное слетает

Дима_ · 24.09.2009, 14:54

Опа - а там'ж еще и отрицательные, вобщем держи - точки украл у VVA:

Код:

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

(vl-load-com)
(setvar "PDMODE" 35)
(setvar "PDSIZE" 50)
(mapcar '(lambda (lay color / tmp)
(if (not (tblobjname "layer" lay))
(progn
(entdel (entmakex (list (cons 0 "circle") (cons 8 lay) (cons 40 1) (list 10 0 0 0))))
(setq tmp (entget (tblobjname "layer" lay)))
(entmod (subst (cons 62 color) (assoc 62 tmp) tmp))
)))
'("Station" "Points" "Numbers") '(1 5 2))

(defun c:torednova ()
(vla-startundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
(princ (strcat "Импортированно " (rtos (length
(mapcar '(lambda (point)
(setq point (append (list (car point) (cadr point)) (mapcar '(lambda (x) (* x 1000)) (cdr(cdr point)))))
(entmakex (list (cons 0 "point") (cons 8 (car point)) (cons 10 (cdr (cdr point)))))
(entmakex (list (cons 0 "text") (cons 8 "Numbers") (cons 10 (cdr (cdr point))) (cons 40 100) (cons 1 (rtos (cadr point)))))
);end of lambda
(mapcar '(lambda (str) (cons (if (= (substr str 1 1) "M") "Station" "Points") (digitextract str)))
(vl-remove-if-not '(lambda (str) (or (= (substr str 1 2) "MP") (= (substr str 1 5) "CO,Pt")))
(readfile (getfiled "Выберите файл с тахеометра" "" "raw" 0)))))
))  " точек."));end of princ&strcat&length&rtos
(vla-endundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
(princ)
);end of torednova

(defun digitextract (str / lstdgt digit char i)
(setq i 1 digit "")
(repeat (strlen str)
(setq char (substr str i 1))
(if 	(or (and (>= char "0") (<= char "9")) (and (= char "-") (= digit "")))
	(setq digit (strcat digit char))
	(if (= char ".")
	(setq digit (strcat digit "."))
	(if (= digit ".") (setq digit "") 
	(if (/= digit "") (setq lstdgt (append lstdgt (list (atof digit))) digit ""))
)));end of if*3
(setq i (1+ i))
);end of repeat
(if (and (/= digit ".") (/= digit "")) (setq lstdgt (append lstdgt (list (atof digit)))))
lstdgt
);end of digitextract

(defun readfile (F / str lst);возращает список строк файла F
(if F (progn
(setq F (open F "r"))
(if F
(progn
(setq str (read-line F))
(while str (setq lst (append lst (list str)) str (read-line F)))
(close F)
))));end of progn&if*2
lst
);end of readfile

Кулик Алексей aka kpblc · 24.09.2009, 15:05

Иcправил #12.

S_Misha · 24.09.2009, 15:10

вообще по инструкции по съемке в м 500 в координатах рабоать запрещено. Работайте в углах, уравниваете, и ошибок меньше будет и контроль, и программы ваши данные обработают. для Для тримблов утановите формат записи M5 и используйте стандартные программы Credo_dat, TGO, я так пользуюсь своей, разработкой специально для тримблов придумал (скачка, уравнивание, экспорт в mapinfo и вавтокад, выдача отчетов)

VVA · 24.09.2009, 15:13

Red Nova,
1. Изменил №11.
2. Координаты умножаются. У тебя в примере координаты такие

Цитата:

CO,Pt:4 X 0.163 m Y -0.071 m Z 0.018 m
CO,Pt:8 X -10.183 m Y 9.979 m Z 0.018 m

ALex_123 · 24.09.2009, 15:24 **точки**

превращаем все в скрипт по расстановке точек, я скидываю сначала в ексель все координаты для получения нужного написания _point X,Y,Z затем блокнот сохроняем в *.scr загружаем в акад и все. Примеры могу скинуть куданибуть. По слоям - просто несколько файлов, в екселе все сортируеться на ура, про умножение, вообще без комментариев. Делаю так, дабы лень придумывать и писать макросы.

Red Nova · 24.09.2009, 15:29

kpblc,
Дима_,
VVA,
Коды каждого из вас теперь работают корректно.
Спасибо всем

Дима_ · 24.09.2009, 15:37

Цитата:

Сообщение от Red Nova

kpblc,
Дима_,
VVA,
Коды каждого из вас теперь работают корректно.
Спасибо всем

Ну будет из чего выбрать. Самое интересное если завтра скажешь - ребята Вам всем надо-бы доделать...

Red Nova · 24.09.2009, 15:46

Подождем завтрашнего дня. А может и послезавтрашнего. Тахеометры еще толком не обкатали. Так что вопросы возможно еще будут.

Red Nova · 12.05.2011, 14:20

С успехом использую код от крЫса

Код:

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

 (defun C:trimble (/		      adoc
		  layers	      *error*
		  fun_creale-layer    _kpblc-conv-string-to-list
		  _kpblc-string-replace-noreg
		  file		      handle
		  str		      lst
		 )

  (defun _kpblc-string-replace-noreg (str old new / pos)
    (while
      (and (setq pos (vl-string-search (strcase old) (strcase str)))
	   (not (vl-string-search (strcase new) (strcase str)))
      ) ;_ end of and
       (setq str (strcat (substr str 1 pos)
			 new
			 (_kpblc-string-replace-noreg
			   (substr str (+ (strlen old) pos 1))
			   old
			   new
			 ) ;_ end of _kpblc-string-replace-noreg
		 ) ;_ end of strcat
       ) ;_ end of setq
    ) ;_ end of while
    str
  ) ;_ end of defun

  (defun _kpblc-conv-string-to-list (string separator / i)
    (cond
      ((= string "") nil)
      ((setq i (vl-string-search separator string))
       (cons (substr string 1 i)
	     (_kpblc-conv-string-to-list
	       (substr string (+ (strlen separator) 1 i))
	       separator
	     ) ;_ end of _kpblc-conv-string-to-list
       ) ;_ end of cons
      )
      (t (list string))
    ) ;_ end of cond
  ) ;_ end of defun

  (defun *error* (msg)
    (vl-catch-all-apply (function (lambda () (close handle))))
    (vla-endundomark adoc)
    (princ msg)
    (princ)
  ) ;_ end of defun

  (defun fun_creale-layer (lst / res)
			  ;|
lst :
	'(("name" . <>)
	  ("color" . <>))
|;
    (if	(vl-catch-all-error-p
	  (vl-catch-all-apply
	    (function
	      (lambda ()
		(setq res (vla-item layers (cdr (assoc "name" lst))))
	      )
	    )
	  )
	) ;_ end of vl-catch-all-error-p
      (setq res (vla-add layers (cdr (assoc "name" lst))))
    ) ;_ end of if
    (vla-put-color res (cdr (assoc "color" lst)))
    res
  ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  )
  (if (and (setq file (getfiled "RAW-file" "" "raw" 4))
	   (/= file "")
	   (findfile file)
      ) ;_ end of and
    (progn
      (setq handle (open file "r"))
      (while (setq str (read-line handle))
	(if (wcmatch (strcase str) "MP*,CO*X*Y*Z*")
	  (setq lst (cons str lst))
	) ;_ end of if
      ) ;_ end of while
      (close handle)
      (setq lst	   (reverse lst)
	    layers (vla-get-layers adoc)
      ) ;_ end of setq
      (foreach item '((("name" . "Station") ("color" . 1))
		      (("name" . "Points") ("color" . 5))
		      (("name" . "Numbers") ("color" . 2))
		     )
	(fun_creale-layer item)
      ) ;_ end of foreach
      (foreach item lst
	(setq
	  str (mapcar
		(function
		  (lambda (x)
		    (if	(= (itoa (atoi x)) x)
		      x
		      (* (atof x) 1000.)
		    ) ;_ end of if
		  ) ;_ end of lambda
		) ;_ end of function
		(vl-remove-if-not
		  (function
		    (lambda (x)
		      (wcmatch x "*[0-9]*")
		    ) ;_ end of lambda
		  ) ;_ end of function
		  (cond
		    ((wcmatch (strcase item) "CO*")
		     (apply
		       (function append)
		       (mapcar
			 (function
			   (lambda (x)
			     (_kpblc-conv-string-to-list x ":")
			   )
			 ) ;_ end of function
			 (_kpblc-conv-string-to-list item " ")
		       ) ;_ end of mapcar
		     ) ;_ end of apply
		    )
		    ((wcmatch (strcase item) "MP*")
		     (_kpblc-conv-string-to-list item ",")
		    )
		  ) ;_ end of cond
		) ;_ end of vl-remove-if-not
	      ) ;_ end of mapcar
	) ;_ end of setq
	(entmakex (list	'(0 . "POINT")
			(cons 8
			      (if
				(wcmatch item "MP*")
				 "Station"
				 "Points"
			      ) ;_ end of if
			) ;_ end of cons
			(cons 10 (cdr str))
		  ) ;_ end of list
	) ;_ end of entmakex
	(entmakex (list	'(0 . "TEXT")
			'(100 . "AcDbEntity")
			'(100 . "AcDbText")
			(cons 10 (cdr str))
			(cons 1 (car str))
			(cons 40 100) ;_A^u^n~i^o`a`
			(cons 7 (getvar "TEXTSTYLE"))
			(cons 72 0)
			(cons 50 0)
			(cons 11 (cdr str))
			(cons 8 "Numbers")
		  ) ;_ end of list
	) ;_ end of entmakex
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
) ;_ end of defun

Возникла потребность кое-что добавить.
Иногда используем тахеометр для построения топографического плана. Пробовал использовать программы для автоматической генерации линий рельефа из точек, но качество так и не получил, так что горизонтали чертим сами.
При этом постоянно нужно лазить в свойства точкам чтобы посмотреть координату Z. Прошу дописать лисп чтобы кроме уже создающихся слоев создавался еще один, по имени "Elivation", и в этом слое вставить в чертеж координату Z для каждой точки, с ее же координатами (желательно justify "top left" чтобы избежать накладки на слой "Numbers").

mamuk · 12.05.2011, 14:51

как же уравнивание хода? это относительно получения координат сразу из тахемоетра.
какие программы исползовали для постороения рельефа?

Red Nova · 12.05.2011, 15:02

mamuk

Цитата:

как же уравнивание хода? это относительно получения координат сразу из тахемоетра.

А что это за зверь и с чем его едят вообще ))?
Мы используем тахеометр далеко не в весь функционал. В основном измеряем отклонения при постройке башен для контроля. Раз в год делаем топо, так что многого могу тут не знать

Цитата:

какие программы исползовали для постороения рельефа?

Самое удачное и единственное что запомнил это Rmaster.

mamuk · 12.05.2011, 15:31

если делаете съемку, то прокладываете теодолитный ход, необходимо определить невязки в ходу по углам и расстояниям если невязки в допуске то раскидываем ошибки по измерениям и считаем координаты хода. это обобщенно. Суть в том что бы получить коодинаты с которых можно вести съемку и уравнивание хода дает нам понять в допуске наши измерения или нет,если нет то в поле перемерять. http://www.drillings.ru/teodolithod?razdel=1&object=0

Red Nova · 12.05.2011, 15:38

Припоминаю курс геодезии ). Но у нас в основном с одной точки измерения. Станцию редко двигаем.

Victor · 15.05.2011, 15:16

Пузырёк на середину научились выводить? Башни не попадают?

Red Nova · 15.05.2011, 15:21

)) Ты видно больно умный...

Victor · 16.05.2011, 23:19

Ну я там про отрицательные координаты почитал. Некоторые сомнения появились. А про колимацию, место зенита, наклон горизонтальной оси - слышали что нибудь?

Кулик Алексей aka kpblc · 17.05.2011, 03:15

Offtop:

Цитата:

Сообщение от Victor

А про колимацию, место зенита, наклон горизонтальной оси

А это не матюк?

Red Nova · 17.05.2011, 16:46

Послушайте Виктор, идите Вы лучше своей дорогой и попридержите свои комментарии.
Я не геодезист и быть им не стараюсь. Беру от инструмента то что мне нужно, и поверьте для поставленной конкретной цели этого более чем достаточно.
Может когда ни будь придется осваивать эту специфику, тогда и вопросы задам и за советы буду благодарен и возможно даже Вам, если конечно Вы ответите на интересующий меня вопрос и не будете снова оставлять комментарии по абсолютно другой теме...

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Информация по идентификационным кодам программ в сетевых лицензиях Autodesk	KSI	AutoCAD	1	14.09.2009 15:59
Импорт точек из файла .job & .are	G-RAV	Программирование	34	20.08.2009 08:20
Импорт координат чертежа в AutoCAD	Wer666	Программирование	3	15.01.2009 11:21
Импорт точек Сьемочного обоснования в AutoCAD	Xamas_DZK	AutoCAD	1	05.11.2007 03:24
Помощь по Лире	Серега М	Лира / Лира-САПР	52	28.05.2007 02:47