Рассчитать длину линий (не суммировать)

desokol · 07.02.2009, 13:55

Существует несколько линий в пространстве. Необходимо автоматически промаркировать элементы (линии). Данные о них собрать в таблице. Таблица состоит из 2 столбцов: № элемента, длина элемента.

Спасибо.

Кулик Алексей aka kpblc · 07.02.2009, 15:24

Поскольку вопрос в разделе "AutoCAD", а версия не озвучена, то, скорее всего, ответ будет: руками. После того, как выяснится, что таблица рисуется AutoCAD'овская, будет добавлено: и полями.

wetr · 07.02.2009, 15:24

desokol,
1. Сделай дин. блок - "Линия" с атрибутом "Марка"
2. Нарисуй сколько нужно этих линий-блоков (для удобства можно воспользоваться лиспом)
3. Пронумеруй с помощью лиспа от VVA
3. Извлеки данные из этих блоков в твою таблицу с помощью _dataextraction или VetCAD

desokol · 08.02.2009, 23:29

Проблема в том что эти линии уже нарисованы. Их несколько сотен. Можно ли извлечь данные в таблицу не из блоков, а из линий?

Дима_ · 09.02.2009, 00:55

Распиши подробней, с примерами что есть и что должно полулучиться на выходе, каким образом отмечать линии, в какой последовательности, формат таблицы - програмка сама по себе простая - просто 45 раз ее "доводить" нет ни какого желания.

SetQ · 09.02.2009, 00:58

можно

Код:

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

(DeFun c:dlina (/ ss N i len K R)
  (If (SetQ ss (ssget "x"
		      '(
			(-4 . "<OR")
			(0 . "LINE")
			(0 . "ARC")
			(0 . "POLYLINE")
			(0 . "LWPOLYLINE")
			(-4 . "OR>")
		       )
	       )
      )
    (ProgN
      (SetQ N (ssLength ss)
	    i 0
      )
      (While (< i N)
	(SetQ ent (ssName ss i)
	      len (GetObjLength ent)
	      i	  (1+ i)
	      R   (Cons (List i len) R)
	)
      )

      (While R
	(ProgN
	  (SetQ	K (Car R)
		R (Cdr R)
	  )
	  ;; печатаем
	  (Prompt "\n")
	  (Princ (Car K))
	  (Prompt " - ")
	  (Princ (Cadr K))
	)
      )
    )
  )
  (prin1) ;_ BB
)

;;; Возвращает длину объекта
;;; ent - объект
(DeFun GetObjLength	(ent)
  (vlax-curve-getDistAtParam
    (vlax-ename->vla-object ent)
    (vlax-curve-getEndParam ent)
  )
)

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

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

desokol · 09.02.2009, 11:00

Есть:
Некоторое колличество линий в трехмерном пространстве.
Получить на выходе:
1.Пронумеровать линии. Лучше чтобы номера не были разбросаны по всему чертежу, а наблюдалась структура. Например слева направо. Т .е. критерий - читабельность чертежа.
2.Извлечь данные о длине и номере элемента в таблицу. Необходимо чтобы длины элементов коррелировали (соответствовали) с номером элемента.
3. Формат таблицы: Автокадовская либо excel.

SetQ,
К сожалению у меня скрипт не запустился.

Спасибо.

Дима_ · 09.02.2009, 11:53

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

SetQ · 09.02.2009, 13:55

команда dlina:

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

Код:

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

(DeFun c:dlina (/ ss N i len K R fd line)
  (If (SetQ ss (ssget "x" '((0 . "LINE"))))
    (ProgN
      (SetQ N (ssLength ss)
	    i 0
      )
      (While (< i N)
	(ProgN
	  (SetQ	ent (ssName ss i)
		len (GetObjLength ent)
		i   (1+ i)
		R   (Cons (List i len) R)
	  )
	  (EntMake
	    (List
	      '(0 . "TEXT")
	      (Assoc 10 (EntGet ent))
	      '(40 . 5.0)
	      (Cons 1 (itoa i))
	    )
	  )
	)
      )

      (SetQ
	R  (Reverse R)
	fd (Open (StrCat (GetVar "DWGPREFIX") "data.csv") "w")
      )

      (TextPage)

      (While R
	(ProgN
	  (SetQ	K    (Car R)
		R    (Cdr R)
		line (StrCat (ItoA (Car K)) ";" (RtoS (Cadr K)))
	  )
	  ;; печатаем
	  (Prompt "\n")
	  (Princ (Car K))
	  (Prompt " - ")
	  (Princ (Cadr K))

	  (Write-Line line fd)
	)
      )
      (Close fd)
    )
  )
  (prin1) ;_ BB
)

;;; Возвращает длину объекта
;;; ent - объект
(DeFun GetObjLength (ent)
  (vlax-curve-getDistAtParam
    (vlax-ename->vla-object ent)
    (vlax-curve-getEndParam ent)
  )
)

(Prompt "\nUse 'dlina' command")
(Prin1)

демонстрация того, что это можно сделать

Дима_ · 09.02.2009, 13:57

"Полуавтоматический" вариант:

Код:

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

(vl-load-com)
(defun c:test ( / numb tabl obj)
(setq numb (getint "\nВведите число с какого начинать отсчет "))
(while (/= (type tabl) 'vla-object)
(setq tabl (car (entsel "\nУкажите таблицу для записи данных ")))
(if (and tabl (= (cdr (assoc 0 (entget tabl))) "ACAD_TABLE")) (setq tabl (vlax-ename->vla-object tabl)))
);end of while
(while T
(setq obj nil)
(while (not obj)
(setq obj (entsel "\nВыберите линию "))
(if (/= (cdr (assoc 0 (entget (car obj)))) "LINE") (setq obj nil))
);end of while
(command "_mleader" (cadr obj) pause (rtos numb))
(if (> (+ 2 numb) (vla-get-rows tabl)) (vla-insertrows tabl (vla-get-rows tabl) 1 (- (+ 2 numb) (vla-get-rows tabl))))
(vla-settext tabl (+ 1 numb) 0 (rtos numb))
(vla-settext tabl (+ 1 numb) 1 (rtos (distance 	(cdr (assoc 10 (entget (car obj))))
						(cdr (assoc 11 (entget (car obj)))))))
(setq numb (1+ numb))
);end of while
);end of test

desokol · 10.02.2009, 10:08

Дима_,
У меня почему-то не получилось проставить позиции на чертеже. Т. е. не обозначается номер элемента.

SetQ,
Спасибо, все работает отлично. Только не мог бы ты модернизировать код, чтобы номер элемента проставлялся в центр линии. Сейчас он ставится в начало линии. Если в одну точку приходит несколько линий, то номера накладываются один на другой.

Спасибо за помощь.

Дима_ · 10.02.2009, 10:42

Цитата:

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

У меня почему-то не получилось проставить позиции на чертеже. Т. е. не обозначается номер элемента.
Спасибо за помощь.

Возможно причина в размерном стиле - посмотри номер наверняка есть, но маленький

SetQ · 10.02.2009, 20:33

desokol, легко, две строчки, завтро

мож ещё что добавить? а правильно-то считает?

desokol · 11.02.2009, 11:04

SetQ, считает правильно. Меня все устраивает. Так что жду от тебя ответа.

Спасибо.

SetQ · 11.02.2009, 11:39

рилайз от сегодня:

ставит марки в середине отрезков
разделитель разрядов - запятая
имя .csv файла - это имя чертежа + расширение .csv

Код:

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

;;; Маркирует все отрезки, считает длину, выводит на экран и в файл
;;; последняя правка - 11/02 2009 by SetQ

(DeFun c:dlina (/ ss N i K R ent lst p0 p1 p2 len len2 fd line)
  (If (SetQ ss (ssget "x" '((0 . "LINE"))))
    (ProgN
      (SetQ N (ssLength ss)
	    i 0
      )

      (While (< i N)
	(ProgN
	  (SetQ	ent  (ssName ss i)
		len  (GetObjLength ent)
		i    (1+ i)
		R    (Cons (List i len) R)
		lst  (EntGet ent)
		p0   (Cdr (Assoc 10 lst))
		p1   (Cdr (Assoc 11 lst))
		len2 (/ (Distance (List (Car p0) (Cadr p0)) p1) 2.0)
		p2   (Polar p0 (Angle p0 p1) len2)
	  )

	  (EntMake
	    (List
	      '(0 . "TEXT")
	      (Cons 10 p2)
	      '(40 . 5.0)		; 5.0 - высота текста
	      (Cons 1 (itoa i))
	    )
	  )
	)
      )

      (SetQ
	R  (Reverse R)
	fd (Open (StrCat (GetVar "DWGPREFIX") (GetVar "DWGNAME") ".csv")
		 "w"
	   )
      )

      (TextPage)

      (While R
	(ProgN
	  (SetQ	K    (Car R)
		R    (Cdr R)
		line (vl-string-subst
		       ","
		       "."
		       (StrCat (ItoA (Car K)) ";" (RtoS (Cadr K)))
		     )
	  )
	  ;; печатаем
	  (Write-Line line fd)
	  (Prompt (StrCat "\n" (vl-string-subst " - " ";" line)))
	)
      )
      (Close fd)
    )
  )
  (prin1) ;_ BB
)

;;; Возвращает длину объекта
;;; ent - объект
(DeFun GetObjLength (ent)
  (vlax-curve-getDistAtParam
    (vlax-ename->vla-object ent)
    (vlax-curve-getEndParam ent)
  )
)

(Prompt "\nUse 'dlina' command")
(Prin1)

desokol · 11.02.2009, 13:00

SetQ
Возможно ли сделать точную привязку текста к центру линии?
У меня некоторые номера сдвинулись по оси Z.

SetQ · 11.02.2009, 13:19

это как - middle у текста? чот не понял про Z, выложи примерчик - как есть и как надо.

по Z что-ли чтобы на нуле лежали?

desokol · 11.02.2009, 13:27

Линия находится в трехмерном пространстве. Запускаю код. Получается, что текст по оси Z лежит не в центре линии. Т. е. координата Z у текста привязана не к центру линии, а видимо к точке p0 или p1.

Если не понятно, то пример отправлю.

desokol · 11.02.2009, 13:34

Врт что получилось.

SetQ · 11.02.2009, 19:16

Код:

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

;;; Маркирует все отрезки, считает длину, выводит на экран и в файл.
;;; Марки расставляет в середины 3d-отрезков
;;; последняя правка - 11/02 2009 by SetQ

(DeFun c:dlina (/ ss N i K R ent lst p0 p1 p2 len len2 fd line)
  (If (SetQ ss (ssget "x" '((0 . "LINE"))))
    (ProgN
      (SetQ N (ssLength ss)
	    i 0
      )

      (While (< i N)
	(ProgN
	  (SetQ	ent (ssName ss i)
		len (GetObjLength ent)
		i   (1+ i)
		R   (Cons (List i len) R)
		lst (EntGet ent)
		p0  (Cdr (Assoc 10 lst))
		p1  (Cdr (Assoc 11 lst))
		p2  (List
		      (simple_average (Car p0) (Car p1))
		      (simple_average (Cadr p0) (Cadr p1))
		      (simple_average (Caddr p0) (Caddr p1))
		    )
	  )

	  ;; вставляем в чертеж марку
	  (EntMake
	    (List
	      '(0 . "TEXT")
	      (Cons 10 p2)		; точка вставки
	      '(40 . 5.0)		; 5.0 - высота текста
	      (Cons 1 (itoa i))		; сам текст
	    )
	  )
	)
      )

      (SetQ
	R  (Reverse R)
	fd (Open (StrCat (GetVar "DWGPREFIX") (GetVar "DWGNAME") ".csv")
		 "w"
	   )
      )

      ;; открывает окно консоли - аналогично F2, если не нужно - моно убрать
      (TextPage)

      (While R
	(ProgN
	  (SetQ	K    (Car R)
		R    (Cdr R)
		line (vl-string-subst
		       ","
		       "."
		       (StrCat (ItoA (Car K)) ";" (RtoS (Cadr K)))
		     )
	  )
	  ;; печатаем
	  (Write-Line line fd)		; в файл
	  (Prompt			; на экран
	    (StrCat "\n" (vl-string-subst " - " ";" line))
	  )
	)
      )
      (Close fd)
    )
    (Alert "Нет ни одной линии в чертеже.")
  )
  (prin1) ;_ BB
)

;;; Возвращает длину объекта
;;; ent - объект
(DeFun GetObjLength (ent)
  (vlax-curve-getDistAtParam
    (vlax-ename->vla-object ent)
    (vlax-curve-getEndParam ent)
  )
)

;;; среднее арифметическое
(DeFun simple_average (a b) (/ (+ a b) 2.0))

(Prompt "\nUse 'dlina' command")
(Prin1)

так? высота текста только жестко в проге задана, она постоянная?

desokol · 12.02.2009, 12:52

SetQ
Спасибо тебе большое! Все работает как надо.
Очень

SetQ · 12.02.2009, 19:48

desokol, на здоровье!

07.02.2009, 13:55		#1
Рассчитать длину линий (не суммировать) desokol Архитектор Санкт-Петербург Регистрация: 07.02.2009 Сообщений: 16 Существует несколько линий в пространстве. Необходимо автоматически промаркировать элементы (линии). Данные о них собрать в таблице. Таблица состоит из 2 столбцов: № элемента, длина элемента. Спасибо.
Просмотров: 6380

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Изменить длину множества линий одним разом	iDemon	AutoCAD	12	27.11.2008 14:04
Близко расположенные линии в чертеже сливаются.	Wowik53	AutoCAD	50	01.11.2008 21:40
Как в автокаде получить общую длину нескольких линий сразу.	Рин	AutoCAD	1	14.04.2008 11:57
Как рассчитать стыки (в стыках) и длину сварки (в м.)?	ACAD	Прочее. Архитектура и строительство	11	19.12.2007 17:58
Как рассчитать длину сварного шва?	Бохан Евгений	Прочее. Архитектура и строительство	6	22.08.2007 11:35

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск

	Реклама i