Программа для установки Z-координаты точки текста рядом с ней

Кочетков Андрей · 02.02.2011, 08:42

Уважаемые программисты!
Прошу помочь мне с написанием программы:
В чертеже существует однотипные группы объектов:
- группа объектов, определяющих положение точки
- текст рядом с ней

Группа объектов, определяющих точку - это 3 объекта:
- окружность
- 2 отрезка

Пересечение отрезков определяет положение точки.

Мне нужна программа, которая работает следующим образом:
1. Запускаю программу
2. Выделяю окружность, 2 отрезка и текст рядом с ними
3. Программа отфильтровывает отрезки, находит координату точки пересечения отрезков
4. Извлекает значение текста (он может быть TEXT и MTEXT, разделитель может быть точка, запятая и без разделителя)
5. Создает объект POINT с координатами X,Y - в точке пересечения отрезков, Z - значение текста
6. Завершает программу

Прошу помочь написать эту программу.

hwd · 02.02.2011, 08:57

Цитата:

Сообщение от Кочетков Андрей

Прошу помочь написать эту программу.

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

Offtop: п.с. напоминает "казнить нельзя помиловать"...

VVA · 02.02.2011, 10:25

Привет Андрей. Писал как-то для другого форума программу по назначению точке координаты Z из ближайшего текста. Может тоже будет интересно

Код:

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

(defun C:Ztxt ( / objSet Point ptLst tmp1 tmp2 pat txtZList dst *error*)
;;;http://www.caduser.ru/cgi-bin/f1/board.cgi?t=44709Oh
;;;Перенос из содержания текста в координату z рядом стоящей точки
;;;Координатой Z выбранной точки считается БЛИЖАЙШИЙ текст

(vl-load-com)
(defun *error*(msg)(princ msg)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))(princ))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))  
(if (and
      (setq objSet(ssget "_:L" '((0 . "POINT"))))
      (setq Point (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
      (setq ptLst(mapcar 'cdr (mapcar '(lambda(x)(assoc 10 x))(mapcar 'entget Point))))
      (setq objSet nil objSet(ssget "_X" (list '(0 . "*TEXT")(cons 410 (getvar "CTAB")))))
      )
  (progn
    (setq tmp1 (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
    (setq tmp1 (mapcar '(lambda(x)(setq x (entget x))(list (cdr(assoc 10 x))(cdr(assoc 1 x)))) tmp1))
    (foreach pt ptlst
      (setq tmp2 (mapcar '(lambda(x)(list (distance pt (car x))(cadr x))) tmp1))
      (setq pat (car tmp2))
      (foreach dst tmp2 (if (< (car dst) (car pat))(setq pat dst)))
      (setq txtZList (cons (cadr pat) txtZList))
      )
    (setq txtZList (reverse txtZList))
    (setq txtZList (mapcar '(lambda(x)
                    (vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))
                   )txtZList))
    (mapcar '(lambda(ptObj pt Z)
               (vla-put-coordinates (vlax-ename->vla-object ptObj)
                (vlax-3d-point (list (car pt)(cadr pt) Z))  
               )
               )
           Point ptLst (mapcar 'atof txtZList)
            )
    )
  )
  (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
  )
(princ "\nType Ztxt in command line")

Ну и на основе этой команды то, что ты просил.
1. Выбираем отрезки (можно сразу все)
2. Ищет попарно все пересечения отрезков
3. Находит ближайший текст к точкам пересечения
4. Рисует точки, где Z - берется из найденного текста

Код:

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

(defun C:L2P ( / objSet Point ptLst tmp1 tmp2 pat txtZList dst *error*)
  ;;;Line to point
  ;;;Vladimir Azarko(VVA) for http://forum.dwg.ru/showthread.php?t=63020
;;; Находит пересечения отрезков и ближейший текст к точкам пересечения
;;; Строит точки в местах пересечения, где Z берется из ближайшего текста
;;;1. Выбираем отрезки (можно сразу все)
;;;2. Ищет попарно все пересечения отрезков
;;;3. Находит ближайший текст к точкам пересечения
;;;4. Рисует точки, где Z - берется из найденного текста
(vl-load-com)
(defun *error*(msg)(princ msg)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))(princ))
(defun MakePoint (pt)(entmakex (list (cons 0 "POINT")(cons 10 pt))))
(defun inters_line ( line elst )
  (vl-remove-if 'null
  (mapcar '(lambda(x)
             (inters
               (cdr(assoc 10 (entget line)))
               (cdr(assoc 11 (entget line)))
               (cdr(assoc 10 (entget x)))
               (cdr(assoc 11 (entget x)))
               )
             )
          elst
    )
  )
  )
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))  
(if (and
      (setq objSet(ssget '((0 . "LINE"))))
      (setq tmp1 (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
      (setq objSet nil objSet(ssget "_X" (list '(0 . "*TEXT")(cons 410 (getvar "CTAB")))))
      )
  (progn
    (while (car tmp1)(setq ptLst (cons (inters_line (car tmp1)(setq tmp1 (cdr tmp1))) ptLst)))
    (setq ptLst(mapcar '(lambda(x)(list (car x)(cadr x) 0))(apply 'append ptLst)))
    (setq tmp1 (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
    (setq tmp1 (mapcar '(lambda(x / y)(setq y (cdr(assoc 10 x)))(list(list (car y)(cadr y) 0)(cdr(assoc 1 x))))(mapcar 'entget tmp1)))
    (foreach pt ptlst
      (setq tmp2 (mapcar '(lambda(x)(list (distance pt (car x))(cadr x))) tmp1))
      (setq pat (car tmp2))
      (foreach dst tmp2 (if (< (car dst) (car pat))(setq pat dst)))
      (setq txtZList (cons (cadr pat) txtZList))
      )
    (setq txtZList (mapcar '(lambda(x)
                    (vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))
                   )(reverse txtZList)))
    (mapcar '(lambda(pt Z)
               (MakePoint (list (car pt)(cadr pt) Z))
               )
           ptLst (mapcar 'atof txtZList)
            )
    )
  )
  (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
  )
(princ "\nType L2P in command line")

Do$ · 02.02.2011, 11:32

Еще вариант (после варианта от VVA может и не понадобится, но что же, зря писал чтоли

).

Цитата:

Сообщение от Кочетков Андрей

Мне нужна программа, которая работает следующим образом:
1. Запускаю программу
2. Выделяю окружность, 2 отрезка и текст рядом с ними
3. Программа отфильтровывает отрезки, находит координату точки пересечения отрезков
4. Извлекает значение текста (он может быть TEXT и MTEXT, разделитель может быть точка, запятая и без разделителя)
5. Создает объект POINT с координатами X,Y - в точке пересечения отрезков, Z - значение текста
6. Завершает программу

Все по пунктам (запускаем командой MAKEPOINT):

Код:

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

(defun c:makepoint
		   (/ ss->lst ru-list-massoc line-inters)

  (defun ss->lst (ss / i ent lst)
    ;;Преобразует набор в ename-список объектов
    ;;(ss->lst (ssget))
    (setq i 0)
    (while (setq ent (ssname ss i))
      (setq lst	(cons ent lst)
	    i	(1+ i)
      ) ;_ end of setq
    ) ;_ end of while
    (reverse lst)
  ) ;_ end of defun

;;; Листинг 10.43. Функция ru-list-massoc
  (defun ru-list-massoc	(key alist)
;;; Пример:(ru-list-massoc 10 (entget (car (entsel))))
    (mapcar 'cdr
	    (vl-remove-if-not
	      (function (lambda (x) (= key (car x))))
	      alist
	    ) ;_ end of vl-remove-if-not
    ) ;_ end of mapcar
  ) ;_ end of defun

  (defun line-inters (ln1 ln2)
    ;;(line-inters (car (entsel "\nLine 1:")) (car (entsel "\nLine 2:")))
    (apply
      'inters
      (apply
	'append
	(mapcar	'(lambda (e)
		   ((lambda (gl)
		      (list (cdr (assoc 10 gl)) (cdr (assoc 11 gl)))
		    ) ;_ end of lambda
		     (entget e)
		   )
		 ) ;_ end of lambda
		(list ln1 ln2)
	) ;_ end of mapcar
      ) ;_ end of append
    ) ;_ end of apply
  ) ;_ end of defun

  ((lambda (ss / lst txt lns adoc z)
     (cond
       ((not ss) (prompt "\nНичего не выбрано!"))
       ((vl-catch-all-error-p ss) nil)
       ((and
	  (or
	    (and
	      (= (length
		   (setq
		     lst
		      (mapcar '(lambda (a)
				 (cons (cdr (assoc 0 (entget a))) a)
			       ) ;_ end of lambda
			      (ss->lst ss)
		      ) ;_ end of mapcar
		   ) ;_ end of setq
		 ) ;_ end of length
		 4
	      ) ;_ end of =
	      (setq
		txt (cdar (vl-member-if
			    '(lambda (a) (wcmatch (car a) "*TEXT"))
			    lst
			  ) ;_ end of vl-member-if
		    ) ;_ end of cdar
	      ) ;_ end of setq
	      (assoc "CIRCLE" lst)
	      (= 2 (length (setq lns (ru-list-massoc "LINE" lst))))
	    ) ;_ end of and
	    (prompt
	      "\nНеправильный выбор! Выберите 2 отрезка, окружность и текст!"
	    ) ;_ end of prompt
	  ) ;_ end of or
	  (or (setq pt (apply 'line-inters lns))
	      (prompt "\nУказанные отрезки не пересекаются!")
	  ) ;_ end of or
	  (or ((lambda (a)
		 (and (wcmatch a "~*@*")
		      (wcmatch a "*#*,*#'.#*,*#,#*")
		 ) ;_ end of and
	       ) ;_ end of lambda
		(cdr (assoc 1 (entget txt)))
	      )
	      (prompt "\nВ тексте не распознано значение Z!")
	  ) ;_ end of or
	) ;_ end of and
	(vla-StartUndoMark
	  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
	) ;_ end of vla-StartUndoMark
	;;(mapcar 'entdel (vl-remove txt (mapcar 'cdr lst)))
	(if (entmakex
	      (list
		(cons 0 "POINT")
		(cons
		  10
		  (list
		    (car pt)
		    (cadr pt)
		    (atof
		      (setq z (vl-string-translate
				","
				"."
				(cdr (assoc 1 (entget txt)))
			      ) ;_ end of vl-string-subst
		      ) ;_ end of setq
		    ) ;_ end of atof
		  ) ;_ end of list
		) ;_ end of cons
	      ) ;_ end of list
	    ) ;_ end of entmakex
	  (prompt (strcat "\nСоздана точка с координатами: Х="
			  (rtos (car pt))
			  "; Y="
			  (rtos (cadr pt))
			  "; Z="
			  z
		  ) ;_ end of strcat
	  ) ;_ end of prompt
	) ;_ end of if
	(vla-EndUndoMark adoc)
       )
     ) ;_ end of cond
   ) ;_ end of lambda
    (vl-catch-all-apply 'ssget '(((0 . "*TEXT,LINE,CIRCLE"))))
  )
  (princ)
) ;_ end of defun

Pastor · 02.02.2011, 13:38

Цитата:

Так помочь, или же написать

Написать, и тем самым помочь. Так, как сделали VVA и Do$.

hwd · 02.02.2011, 14:02

Цитата:

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

Написать, и тем самым помочь. Так, как сделали VVA и Do$.

Вон оно как оказывается...

ну спасибо за пояснение

Кочетков Андрей · 02.02.2011, 14:40

Уважаемый Володя! Уважаемый Do$!
Спасибо! Вы как всегда выручаете в трудную минуту

timoshetc · 15.11.2012, 10:08

у меня текст не распознает! выделяю группу, акад пишет: найдено 0

VVA · 15.11.2012, 13:11

timoshetc, Здесь телепатов нет. Укажи с какого поста используешь программу и приложи dwg файл

timoshetc · 15.11.2012, 14:29

VVA, пользуюсь вашим лиспом Ztxt из поста №3

у меня еще одна проблема, у меня вместо точек круги((( можно ли их исправить на точки??

sertor · 15.11.2012, 18:15

timoshetc, попробуйте этот набор программ. Описание в файле.

ciril · 16.11.2012, 13:07

Цитата:

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

timoshetc

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

VVA · 16.11.2012, 13:34

Цитата:

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

у меня еще одна проблема, у меня вместо точек круги((( можно ли их исправить на точки??

можно
LISP. Замена набора примитивов на выбранный примитив

timoshetc · 16.11.2012, 17:26

ciril, так экспортирует GRS 7.0....и исполнитель это Я) делал съемку с ходом одновременно..вот как то так)))

sertor, спасибо. все помогло.

VVA, спасибо! Вы всегда помогаете мне...ленивому в поиске

Sta1917 · 26.11.2012, 00:44

timoshetc если вы получаете файл XYZ с прибора или из программы обработки экспортируйте одной программ:
ImportXYZ
Импорт координат из текстового файла (txt, sdr, csv)

timoshetc · 27.11.2012, 10:13

Sta1917, еще раз спасибо за беспокойство, но в посте выше я уже отписался о решении данной проблемы

Sta1917 · 27.11.2012, 23:00

Offtop: Я об упрощении, в Credo_DAT например, это есть по умолчанию

02.02.2011, 08:42		#1
Программа для установки Z-координаты точки текста рядом с ней Кочетков Андрей Java/Kotlin/Go Регистрация: 03.02.2006 Сообщений: 5,786 Уважаемые программисты! Прошу помочь мне с написанием программы: В чертеже существует однотипные группы объектов: - группа объектов, определяющих положение точки - текст рядом с ней Группа объектов, определяющих точку - это 3 объекта: - окружность - 2 отрезка Пересечение отрезков определяет положение точки. Мне нужна программа, которая работает следующим образом: 1. Запускаю программу 2. Выделяю окружность, 2 отрезка и текст рядом с ними 3. Программа отфильтровывает отрезки, находит координату точки пересечения отрезков 4. Извлекает значение текста (он может быть TEXT и MTEXT, разделитель может быть точка, запятая и без разделителя) 5. Создает объект POINT с координатами X,Y - в точке пересечения отрезков, Z - значение текста 6. Завершает программу Прошу помочь написать эту программу.
Просмотров: 6503

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива	Profan	Готовые программы	272	06.06.2021 23:12
Нужно узнать координаты каждой точки 3D модели	Babun	AutoCAD	8	14.10.2008 08:38
Координаты текста из AutoCAD в Excel	Rus2007	AutoCAD	11	23.10.2007 16:36
Координаты точки пересечения line и pline (LISP)	paradoxvaha	LISP	3	10.07.2007 13:04
Координаты точки, лежащей на полилинии	Al_Taron	Программирование	1	27.11.2006 09:45