| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен LISP для суммы длин отрезков линни

Нужен LISP для суммы длин отрезков линни

Ответ
Поиск в этой теме
Непрочитано 26.02.2004, 10:13
Нужен LISP для суммы длин отрезков линни
ilka_t
 
Москва
Регистрация: 20.01.2004
Сообщений: 154

Подскажити где можно скачать или поделитись если у кого есть такое.

Полилиния не подходит т.к. эти отрезки разбросаны по всему чертежу, а надобы выбрав несколько линий узнать их общую длинну.
Просмотров: 140317
 
Непрочитано 17.09.2015, 12:15
#161
Vilen


 
Регистрация: 16.09.2015
Сообщений: 1


Цитата:
Сообщение от dew Посмотреть сообщение
ребята а можно переделать данный код чтобы результат можно было бы вставить в таблицу (в нужную ячейку) на чертеже

Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.1) ;_Масштаб 
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста

(vl-load-com)
(if (null *MIP-MODEMACRO-HTXT*)(setq *MIP-MODEMACRO-HTXT* 3.0)) ;_Высота текста
(if (null *MIP-MODEMACRO-RTOS*)(setq *MIP-MODEMACRO-RTOS* -1.0));_Округление -1-LUPREC
(if (null *MIP-MODEMACRO-SCALE*)(setq *MIP-MODEMACRO-SCALE* 1)) ;_Масштаб
(VL-PROPAGATE '*MIP-MODEMACRO-HTXT*)
(VL-PROPAGATE '*MIP-MODEMACRO-RTOS*)
(VL-PROPAGATE '*MIP-MODEMACRO-SCALE*)
(defun C:entLen1 (/ set:entities      int:allEntities 
            int:curveEntities int:l        rea:length 
        )
  (princ "\nТекущий коэффициент K=")(princ (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*))
  (if (not (setq set:entities (cadr (ssgetfirst))))    ; Этот if добавлен для 
    (setq set:entities (ssget "_:E:S"))            ; обработки предварительного 
  ) ;_ if                  ; выбора примитивов 
  (if set:entities 
    (progn 
      (setq int:allEntities 
        (sslength set:entities)  ; количество выбранных примитивов 
      int:curveEntities 
        0            ; счетчик линейных примитивов 
      int:l 0        ; счетчик 
      rea:length 
        0.0        ; общая длина линейных примитивов 
      ) ;_  setq 
      (while (< int:l (sslength set:entities)) 
  (if 
    (not 
      (vl-catch-all-error-p 
        (vl-catch-all-apply 
      'vlax-curve-getStartPoint 
      (list 
        (vlax-ename->vla-object (ssname set:entities int:l)) 
      ) ;_ list 
        ) ;_  vl-catch-all-apply 
      ) ;_  vl-catch-all-error-p 
    ) ;_  not 
      (setq int:curveEntities (1+ int:curveEntities) 
      rea:length      (+ rea:length 
                  (vlax-curve-getDistAtParam 
              (vlax-ename->vla-object 
                (ssname set:entities int:l) 
              ) ;_ vlax-ename->vla-object 
              (vlax-curve-getEndParam 
                (ssname set:entities int:l) 
              ) ;_ vlax-curve-getEndParam 
                  ) ;_  vlax-curve-getDistAtParam 
              ) ;_  + 
      ) ;_  setq 
  ) ;_  if 
  (setq int:l (1+ int:l)) 
      ) ;_  while
      (setq *MIP-LENGTH* (* *MIP-MODEMACRO-SCALE* rea:length))
      (princ (strcat "\n Выбрано примитивов: " 
          (itoa int:allEntities) 
          ", из них линейных: " 
          (itoa int:curveEntities)
          "\nПоправочный коэфиициент K="                    
          "\n Общая длина линейных примитивов: "
        (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))                    
        ) ;_ strcat 
      ) ;_ princ 
    ) ;_  progn 
    (alert "Примитивы не выбраны!") 
  ) ;_  if 
  (prin1) 
(defun TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p
      (vl-catch-all-apply
        '(lambda()
          (vla-put-TextString vlaObj pasteStr)
          (vla-put-Color vlaObj 3)  ;3-номер цвета
          )
        )
      )
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))
присоединяюсь к просьбе.
если решение уже найдено, поделитесь пожалуйста, спасибо!
Vilen вне форума  
 
Непрочитано 17.09.2015, 18:20
#162
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Vilen, А этот вариант не подойдет?

Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.1) ;_Масштаб 
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста

(vl-load-com)
(if (null *MIP-MODEMACRO-HTXT*)(setq *MIP-MODEMACRO-HTXT* 3.0)) ;_Высота текста
(if (null *MIP-MODEMACRO-RTOS*)(setq *MIP-MODEMACRO-RTOS* -1.0));_Округление -1-LUPREC
(if (null *MIP-MODEMACRO-SCALE*)(setq *MIP-MODEMACRO-SCALE* 1)) ;_Масштаб
(VL-PROPAGATE '*MIP-MODEMACRO-HTXT*)
(VL-PROPAGATE '*MIP-MODEMACRO-RTOS*)
(VL-PROPAGATE '*MIP-MODEMACRO-SCALE*)
(defun C:entLen1 (/ set:entities      int:allEntities 
            int:curveEntities int:l        rea:length 
        )
  (princ "\nТекущий коэффициент K=")(princ (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*))
  (if (not (setq set:entities (cadr (ssgetfirst))))    ; Этот if добавлен для 
    (setq set:entities (ssget "_:E:S"))            ; обработки предварительного 
  ) ;_ if                  ; выбора примитивов 
  (if set:entities 
    (progn 
      (setq int:allEntities 
        (sslength set:entities)  ; количество выбранных примитивов 
      int:curveEntities 
        0            ; счетчик линейных примитивов 
      int:l 0        ; счетчик 
      rea:length 
        0.0        ; общая длина линейных примитивов 
      ) ;_  setq 
      (while (< int:l (sslength set:entities)) 
  (if 
    (not 
      (vl-catch-all-error-p 
        (vl-catch-all-apply 
      'vlax-curve-getStartPoint 
      (list 
        (vlax-ename->vla-object (ssname set:entities int:l)) 
      ) ;_ list 
        ) ;_  vl-catch-all-apply 
      ) ;_  vl-catch-all-error-p 
    ) ;_  not 
      (setq int:curveEntities (1+ int:curveEntities) 
      rea:length      (+ rea:length 
                  (vlax-curve-getDistAtParam 
              (vlax-ename->vla-object 
                (ssname set:entities int:l) 
              ) ;_ vlax-ename->vla-object 
              (vlax-curve-getEndParam 
                (ssname set:entities int:l) 
              ) ;_ vlax-curve-getEndParam 
                  ) ;_  vlax-curve-getDistAtParam 
              ) ;_  + 
      ) ;_  setq 
  ) ;_  if 
  (setq int:l (1+ int:l)) 
      ) ;_  while
      (setq *MIP-LENGTH* (* *MIP-MODEMACRO-SCALE* rea:length))
      (princ (strcat "\n Выбрано примитивов: " 
          (itoa int:allEntities) 
          ", из них линейных: " 
          (itoa int:curveEntities)
          "\nПоправочный коэфиициент K="                    
          "\n Общая длина линейных примитивов: "
        (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))                    
        ) ;_ strcat 
      ) ;_ princ 
    ) ;_  progn 
    (alert "Примитивы не выбраны!") 
  ) ;_  if 
  (prin1) 
(defun TTC_Paste(pasteStr keepText / nslLst vlaObj tblobj tblset pt row col lst)
(if (progn
      (initget "T Т _T T")
      (setq nslLst(nentsel "\nТекст, атрибут или размер для вставки или [ячейка Таблицы] <выход>: "))
      (if (not(listp nslLst))(setq nslLst (list nslLst)))
      )
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p
      (vl-catch-all-apply
        '(lambda()
          (vla-put-TextString vlaObj pasteStr)
          (vla-put-Color vlaObj 3)  ;3-номер цвета
          )
        )
      )
(princ "\nError. Can't pase text. "))); end condition #4
((and (= 1(length nslLst))(eq (car nslLst) "T"))
 (initget 1)
 (setq pt (getpoint "\nPick poit in table sell: "))
 (and
 ;_Проверяем, попала ли точка в ячейку таблицы
      (setq  tblobj nil tblset (ssget "_X" (list (cons 0  "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
      (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
      (mapcar '(lambda (x)
           (or tblobj
               (and
                 (= :vlax-true (vla-HitTest x
                               (vlax-3d-point (trans pt 1 0))
                               (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                               'row 'col))
                 (setq tblobj x)
                 )))
        lst)
      tblobj row col
      (vla-SetText tblobj row col pasteStr))); end condition #5
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))


Цитата:
Команда: entlen1

Текущий коэффициент K=0.1
Выберите объекты:

Выбрано примитивов: 1, из них линейных: 1
Поправочный коэффициент K=
Общая длина линейных примитивов: 13.32
Текст, атрибут или размер для вставки или [ячейка Таблицы] <выход>: Т

Pick poit in table sell:

Команда:
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 24.05.2017, 06:47
#163
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,508


Всем привет. Есть рельеф земли в виде полилинии, нужно посчитать расстояние по рельефу. То есть на каждом участке суммировать с предыдущим. Смотрел здесь http://forum.dwg.ru/showpost.php?p=734502&postcount=19 но что то никак не выбрал нужную. Подскажите, пожалуйста. 4 км считать вручную через свойства тяжко
Вложения
Тип файла: dwg
DWG 2007
Рельеф.dwg (89.9 Кб, 26 просмотров)
Рyslan вне форума  
 
Непрочитано 24.05.2017, 07:35
#164
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,587


Рyslan, после просмотра файла сложилось впечатление, что Вам ведь не посчитать суммарную длину нужно (такого рода скриптов море), а вывести расстояние от начальной точки, до конца каждого отрезка, строго соблюдая последовательность и рельеф. А это несколько другая задача.
Boxa вне форума  
 
Непрочитано 24.05.2017, 07:40
#165
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,508


Да да, на каждом участке рельефа сумма предыдущего и данного участка 0, 0+20, 0+20+30, 0+20+50 и так далее. И участки могут быть разной длины. Вообще рельеф идет одной полилинией. Я просто разбил ее, хотел считать вручную. Потом стал искать лисп. Пока что в Веткаде спецкалькулятором тренируюсь. Но тут текст еще корректировать нужно, поворачивать его . Но он действительно суммирует длины по участкам, уже легче
Рyslan вне форума  
 
Непрочитано 24.05.2017, 07:47
#166
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,587


Я бы попробовал без всякого программирования, порезанные отрезки загнать в ексель (_DATAEXTRACTION), с длиной и координатой Х начальной точки, отсортировал бы по координате и потом бы, в нижних ячейках просуммировал бы длины как нужно и вставил бы таблицу в акад, растянув и задав соответствующее форматирование.
Прошу прощения, стандартный DATAEXTRACTION координаты вершин полилинии не возващает.

Последний раз редактировалось Boxa, 24.05.2017 в 08:29.
Boxa вне форума  
 
Непрочитано 24.05.2017, 08:01
#167
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,508


Можно попробовать. Возиться с этим экселем не охота. Я тут недавно пользовался программкой NumInc, отлично значение текста суммирует, можно массивом через интервал текст вставлять. Вот такое бы и сюда для подсчета
Рyslan вне форума  
 
Непрочитано 24.05.2017, 08:49
#168
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Рyslan, на профиле ведь обычно считают расстояние по горизонтали - пикетаж? Если так, то есть простое решение. Правильно ли я понял, что нужно записывать длину наклонных линий, а не их горизонтальное проложение?
skkkk вне форума  
 
Непрочитано 24.05.2017, 09:04
#169
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,508


Цитата:
Сообщение от skkkk Посмотреть сообщение
на профиле ведь обычно считают расстояние по горизонтали - пикетаж?
Есть расстояния между объектами (линейные), есть расстояние по рельефу. Да нужны "наклонные полилинии", причем еще рельеф (полилинию) разбить нужно по участкам)

Вот сейчас спецкалькулятором один профиль посчитал по рельефу, конечно быстрее чем через свойства, но...может можно еще быстрее
Миниатюры
Нажмите на изображение для увеличения
Название: Профиль_подвал.png
Просмотров: 57
Размер:	131.5 Кб
ID:	188581  

Последний раз редактировалось Рyslan, 24.05.2017 в 09:10.
Рyslan вне форума  
 
Непрочитано 24.05.2017, 09:19
#170
P_S


 
Регистрация: 09.10.2006
Санкт-Петербург
Сообщений: 99


Задача ещё усложняется различием вертикального и горизонтального масштабов профиля.
P_S вне форума  
 
Непрочитано 24.05.2017, 09:29
#171
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,508


Цитата:
Сообщение от P_S Посмотреть сообщение
Задача ещё усложняется различием вертикального и горизонтального масштабов профиля.
Масштаб не важен. если что по горизонтали полилинию отмасштабирую. главное чтоб 1:1 считал.
Рyslan вне форума  
 
Непрочитано 24.05.2017, 10:06
1 | #172
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Рyslan, набросал наскоро, бегло потестировал, вроде полет нормальный.
Сначала (временно) убираем в сторону все вертикальные объекты, не то обработает все не так, как надо (не стал делать их обработку). Затем указываем точку, от которой берется Y-координата для вставки текстов, затем указываем начальную точку (самую первую вершину первой линии, где 0.000).
Код:
[Выделить все]
 (vl-load-com)
(defun C:TEST ( / *error* oldDIMZIN ins_pt Y pt en len zoom_flag  txt_obj txt_obj_pt move_pt ss)
	(defun *error* (msg)
		(if oldDIMZIN (setvar "DIMZIN" oldDIMZIN))
		(if zoom_flag (vla-ZoomPrevious (vlax-get-acad-object)))
	)
	(setq oldDIMZIN (getvar "DIMZIN")
		  ins_pt (getpoint "\nУкажите Y-координату расположения текстов: ")
		  Y (cadr ins_pt)
		  pt (getpoint "\nУкажите стартовую точку: ")
		  ins_pt (list (car pt) Y 0.0)
		  en T
	)
	(setq len (getreal "\nВведите стартовую длину: <0.00>"))
	(if (null len) (setq len 0))
	(if (and ins_pt pt)
		(progn
			(vla-ZoomAll (vlax-get-acad-object))
			(setq zoom_flag T)
		)
	)
	(setvar "DIMZIN" 0)
	(while (and pt ins_pt en)
		(or (setq len len) (setq len 0))
		(setq txt_obj 
			(vla-AddMText 
				(vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object)))
				(vlax-3d-point ins_pt)
				0
				(vl-string-subst "," "." (rtos len 2 2))
			)
		)
		(vla-put-AttachmentPoint txt_obj 4)
		(vla-put-Rotation txt_obj (/ pi 2))
		(setq txt_obj_pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint txt_obj)))
			  move_pt (list (car txt_obj_pt) Y 0.0)
		)
		(vla-Move txt_obj (vlax-3D-point txt_obj_pt) (vlax-3D-point move_pt))
		(setq ss 
			(ssget 
				"_C"
				(polar pt (/ pi 4) 0.01)
				(polar pt (/ (* 5 pi) 4) 0.01)
				(list (cons 0 "LWPOLYLINE"))
			)
		)
		(if (and en (= (type en) 'ENAME)) (setq ss (ssdel en ss)))
		(setq en (ssname ss 0))
		(if en 
			(setq pt (vlax-curve-getEndPoint en)
				  len 
					(if len
						(+ len (vlax-curve-getDistAtPoint en pt))
						(vlax-curve-getDistAtPoint en pt)
					)
				  ins_pt (list (car pt) Y 0.0)
			)
		)
	)
	(*error* nil)
)
Результат во вложении.

----- добавлено через ~6 мин. -----
Цитата:
Сообщение от Рyslan Посмотреть сообщение
причем еще рельеф (полилинию) разбить нужно по участкам
LISP. Разорвать объекты в точках пересечения. BreakObjects.

----- добавлено через ~22 мин. -----
Посмотрел скрин-пример в #169 - стало ясно, что не нужно везде делать префикс "0.000+", да и два знака после запятой там. Исправил
Вложения
Тип файла: dwg
DWG 2010
Рельеф.dwg (102.0 Кб, 20 просмотров)

Последний раз редактировалось skkkk, 24.05.2017 в 12:51.
skkkk вне форума  
 
Непрочитано 24.05.2017, 11:58
#173
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,508


skkkk Супер, спасибо! А можно еще добавить выбор, чтобы не всегда с 0 считала, а с выбранной цифры?
Рyslan вне форума  
 
Непрочитано 24.05.2017, 12:22
#174
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Рyslan, а как? С выбранного места она считает с любого, но первое число - 0. Как проге "объяснить", сколько было до этого линий, и какая стартовая длина? В число первых запросов добавить выбор объекта (текстового) из которого возьмется начальная длина? Или просто запросить число?
skkkk вне форума  
 
Непрочитано 24.05.2017, 12:30
#175
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,508


Цитата:
Сообщение от skkkk Посмотреть сообщение
Или просто запросить число?
Ладно, что-то я наглею ))) Пусть так останется. Вот у меня например 3 профиля, первый я разбил и от 0 посчитал. Вторую полилинию стыкую с первой, также разбиваю, убираю подсчет от 0 и заново уже две линии считаю, точно также с третьей. Тогда все цифры получаются по порядку, просто их потом на разные профиля раскидал. Большое пребольшое спасибо!!! То что я полдня обсчитывал, твоя программа сделала за 15 минут
Рyslan вне форума  
 
Непрочитано 24.05.2017, 12:51
#176
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Цитата:
Сообщение от Рyslan Посмотреть сообщение
Ладно, что-то я наглею )))
Ладно уж, это ж мелочи
Добавил запрос стартовой длины. Если на этот запрос нажать Enter, то будет ноль.
Обновил в #172.
Если будет удобнее, можно вместо ввода длины взять ее с текста. Это несложно.

----- добавлено через ~8 мин. -----
Тут есть еще один момент. Надо, чтобы направление полилинии, обозначающей поверхность земли, до разбивки на куски по 20 м (по горизонтали) было слева направо. Проверить можно, выбрав полилинию и потыкать пункт "Вершины" в свойствах. Обратить - с помощью _PEDIT. Просто прога сканирует у каждого куска (разбитой полилинии) вершины от левой к правой (от начальной к конечной), берет новый кусок справа, ставит его длину - и так, пока не кончатся куски.
skkkk вне форума  
 
Непрочитано 24.05.2017, 13:10
#177
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,508


Спасибо! Я понял, я ее недавно Оверкилом чистил. Я вот щас сравнил первый вариант со вторым, почему то пересчет был с разницей 0,01. Обрати внимание на последнюю длину
Вложения
Тип файла: dwg
DWG 2013
Рельеф.dwg (78.2 Кб, 24 просмотров)

Последний раз редактировалось Рyslan, 24.05.2017 в 13:17.
Рyslan вне форума  
 
Непрочитано 24.05.2017, 18:49
#178
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от skkkk Посмотреть сообщение
Надо, чтобы направление полилинии, обозначающей поверхность земли, до разбивки на куски по 20 м (по горизонтали) было слева направо
Не проблема перед применением твоей программы проверить и реверсировать, при необходимости, все полилинии по часовой как отдельной командой, так и включив пару функций в твой код
http://www.cadtutor.net/forum/showth...l=1#post405249
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 24.05.2017, 19:23
#179
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


VVA, никак не возьму в толк: что значит "по часовой". С замкнутыми - ясно, а вот у меня строго горизонтальная полилиния с направлением обхода слева на право. Она - по часовой или против в данном контексте? Или сверху вниз - она как? Как-то пытался связаться с этим "клоквайзом", чтобы определить угол поворота полилинии - влево или вправо по ходу движения (кажется, нашел функцию Евгения Елпанова) - сломал весь мозг, с моей логикой она не увязалась, и я сделал по-другому. Попробовал коды из твоей ссылки - еще больше сбился с толку. PL-CW вообще ничего не делает, а PL-CCW меняет направление на обратное. А как сделать по-любому слева направо, так и не понял.

Рyslan, кстати, ты пока нет-нет да и проверяй результаты. Выбери все полилинии до какого-то текста с их суммой и проверь суммарную длину (думаю, знаешь, как). Мало ли чего.

----- добавлено через ~21 мин. -----
Цитата:
Сообщение от Рyslan Посмотреть сообщение
Я вот щас сравнил первый вариант со вторым, почему то пересчет был с разницей 0,01. Обрати внимание на последнюю длину
Только сейчас увидел эту дописку. Разница в 0.01 - это старая как мир (программирования) проблема - результат вычислений над числами с плавающей запятой. Ты в первый раз скорее всего прогнал прогой весь профиль, а второй - по частям, вводя на началах разбитых фрагментов длину с клавиатуры с двумя знаками после запятой. В первом случае третий знак после запятой не пишется, но участвует в расчетах. И в сумме он может дать, например, 0.004 или 0.005. При округлении до двух знаков третий знак теряется, и не складывается далее с последующими, округляясь по математическим правилам: 0.04 -> 0.0, а 0.05 -> 0.1. Во втором случае третий знак потерялся, и не просуммировался с последующими значениями, поэтому и разница в 0.1. Чтобы этого избежать, надо в расчетах брать не все знаки после запятой, а переводить обратно в число строку, которая вписывается в текст. Конечно, тысячная метра для геодезии - фигня, но осадок остается, и некоторые придирчивые проверялы прям потирают ручки при виде подобных оплошностей. Подправлю по возможности, вместе с обработкой направления полилиний, когда пойму, как это сделать.
skkkk вне форума  
 
Непрочитано 24.05.2017, 21:57
#180
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от skkkk Посмотреть сообщение
чтобы определить угол поворота полилинии - влево или вправо по ходу движения
Здесь выложил функцию D. C. Broad, Jr. sideof
Цитата:
Сообщение от VVA Посмотреть сообщение
;;; D. C. Broad, Jr.
;;; (sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>)
;;; return values
;;; negative = point is to the right side of the ray
;;; 0 = point is on the ray
;;; otherwise point is on the left side of the ray.
;;; P1 should not equal P2 for meaningful results.
Позволяет узнать, справа или слева от луча находится проверяемая точка
По поводу PL-CW, PL-CCW - в основе код Евгения Елпанова, корни нужно искать на caduser'e и там, по моему, для точного определения направления нужно 3 точки.

Цитата:
Сообщение от skkkk Посмотреть сообщение
PL-CW вообще ничего не делает
Значит считается, что обход линии идет по часовой и нет необходимости реверсировать линию

Цитата:
Сообщение от skkkk Посмотреть сообщение
PL-CCW меняет направление на обратное
Значит считается, что обход линии идет по часовой и нужно реверсировать линию
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен LISP для суммы длин отрезков линни

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

Расширенный поиск