[Radio538]

Добрый день! Возникла проблема с определением длин отрезков замкнутой полилиннии и экспортом их в текстовый файл (любой формат txt, doc, exel и пр.). В чем смысл:
Необходимо в табличной форме представить поочередно длины отрезков замкнутой полилинии по порядку построения точек (от начальной и через все промежуточные до конечной). Измерять вручную очень трудозатратно и отнимает много времени, а таких замкнутых объектов очень много и порой состоят они из 100 и более точек. В общем, кто что может посоветовать. Буду рад любым вариантам. Возможно есть какие-то lisp приложения?

[Mustang26rus]

команда _dataextraction

[Кулик Алексей aka kpblc]

Так там вроде нет длины по сегментам...

[AlexV]

Сообщение от Mustang26rus команда _dataextraction

Она выдаст только общую длину, без "разбиения" на отрезки. Можно взорвать предварительно полилинию, тогда получится табличка с длинами отрезков, но отсортировать их по порядку следования будет проблематично (то бишь отсортировать можно либо по длинам, либо по координатам вершин).
Есть еще команда _list, она выдаст координаты вершин по порядку, но без длин отрезков.

[Кулик Алексей aka kpblc]

На самом деле есть еще как минимум один вопрос: а как поступать с дуговыми сегментами?

[ProPeller]

Вот такую программку давным давно нашел, автора не знаю, но благодарен ему безгранично.

Код:

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

 

(vl-load-com)


(defun *error* (msg)
  (princ)
)



(defun c:geo_table ()
   (initget 1 "Полилиния Точки")
   (setq x (getkword "\nПостроить ведомость по [Полилиния/Точки]: ")) 
   (if (= x "Полилиния") (ExportInExcel) (geo_point_table)) 
);_end defun



(defun geo-create-object (AppString)  
  (vlax-create-object AppString)
);_end defun






(defun geo_get_distance (pnt1 pnt2) 
   (setq pnt1 (list (car pnt1) (cadr pnt1)))
   (setq pnt2 (list (car pnt2) (cadr pnt2)))
   (distance pnt1 pnt2) 
);_end defun


(defun geo_get_angle (pnt1 pnt2) 
   (setq pnt1 (list (car pnt1) (cadr pnt1)))
   (setq pnt2 (list (car pnt2) (cadr pnt2)))
   (angle pnt1 pnt2) 
);_end defun






(defun geo-add-text (TextString InsertionPoint Height Alignment Rotation / obj)
  (if (null Alignment) (setq Alignment acAlignmentLeft))
  (setq obj (vla-addtext 
                (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))) TextString 
    (if (or (= Alignment acAlignmentAligned)  
            (= Alignment acAlignmentFit))          
        (vlax-3d-point (car InsertionPoint)) 
        (vlax-3d-point InsertionPoint)
     ) Height))
  (cond
    ((= Alignment acAlignmentLeft) (vla-put-rotation obj Rotation))
    ((or (= Alignment acAlignmentAligned)
         (= Alignment acAlignmentFit))
     (vla-put-alignment obj Alignment)
     (vla-put-textalignmentpoint obj (vlax-3d-point (cadr InsertionPoint)))
    )
    (T
      (vla-put-alignment obj Alignment)
      (vla-put-textalignmentpoint obj (vlax-3d-point InsertionPoint))
      (vla-put-rotation obj Rotation)
    )
    (vla-update obj)
  );_end cond
      
);_end defun





(defun geo-add-line (StartPoint EndPoint Lineweight / obj)
  (setq obj (vla-addline 
                (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))) 
            (vlax-3d-point StartPoint) (vlax-3d-point EndPoint)))

  (cond
    ((vlax-write-enabled-p obj)
      (if Lineweight (vla-put-lineweight obj Lineweight)) 
      (vla-update obj)
  ))         
);_end defun





(defun list-massoc (key alist)
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist))
) 



(defun pline-list-vertex (ent / list_vertex tmp_ent type_ent)
    (setq tmp_ent  ent
          ent      (entget ent)
          type_ent (cdr (assoc 0 ent))
    ) ;_ end of setq
    (cond
        ((= "LWPOLYLINE" type_ent)
         (list (list-massoc 10 ent) (= 1 (logand 1 (cdr (assoc 70 ent)))))
        )
        ((= "POLYLINE" type_ent)
         (reverse
             (cons (= 1 (logand 1 (cdr (assoc 70 ent))))
                   (while (and (setq tmp_ent (entnext tmp_ent))
                               (/= (cdr (assoc 0 (setq ent (entget tmp_ent))))
                                   "SEQEND"
                               ) ;_ end of =
                          ) ;_ end of and
                       (setq list_vertex (cons (cdr (assoc 10 ent)) list_vertex))
                   ) ;_ end of while
             ) ;_ end of cons
         ) ;_ end of reverse
        )
        ((= "LINE" type_ent)
         (list (cons (cdr (assoc 10 ent)) (cons (cdr (assoc 11 ent)) nil)) nil)
        )
        (t nil)
    ) ;_ end of cond
) ;_ end of defun



(defun ExportInExcel ()

    (setq ent (car (entsel "\nУкажите полилинию: "))) 
    (setq lst (car (pline-list-vertex ent)))
    (setq point_count (length lst))
    (setq point_number 0)
    
    
    ;(vl-load-com)
    (setq g_oex (vlax-get-or-create-object "Excel.Application"))
    (vlax-put-property g_oex 'SheetsInNewWorkbook 1)
    (vlax-put-property g_oex 'Visible :vlax-true)
    (setq g_wbs (vlax-get-property g_oex 'Workbooks))
    (setq g_cb (vlax-invoke-method g_wbs 'Add))
    (setq g_shs (vlax-get-property g_cb 'Sheets))
    (setq g_csh (vlax-get-property g_shs 'Item 1))
    (vlax-put-property g_csh 'Name "Координаты")


    (repeat point_count
       (setq pt (nth point_number lst));координаты текущей узловой точки
       (setq pt_next (nth (rem (1+ point_number) point_count) lst));координаты следующей узловой точки (по кругу)
       (setq X (car pt));координата X точки
       (setq Y (cadr pt));кооордината Y точки
       (setq X_next (car pt_next));координата X следующей точки
       (setq Y_next (cadr pt_next));координата Y следующей точки
       (setq Dist (geo_get_distance pt pt_next));расстояние между двумя координатами
       (setq Ang (geo_get_angle (list Y X) (list Y_next X_next)));угол между двумя координатами
       (setq StAng (angtos ang 1 3));Преобразовываем в строку
       (setq StAng (vl-string-subst "° " "d" StAng));Заменяем символ d(град) на символ '° '
       (setq StAng (vl-string-subst "' " "'" stang));Заменяем символ '(мин) на символ '' '    


       (setq RangeN (strcat "A" (itoa (1+ point_number))));Диапазон ячеек для номера точки
       (setq RangeX (strcat "B" (itoa (1+ point_number))));Диапазон ячеек для координаты X
       (setq RangeY (strcat "C" (itoa (1+ point_number))));Диапазон ячеек для координаты Y
       (setq RangeD (strcat "D" (itoa (1+ point_number))));Диапазон ячеек для расстояния  
       (setq RangeA (strcat "E" (itoa (1+ point_number))));Диапазон ячеек для угла        

       (setq g_r0 (vlax-get-property g_oex "Range" RangeN))
       (setq g_r1 (vlax-get-property g_oex "Range" RangeX))
       (setq g_r2 (vlax-get-property g_oex "Range" RangeY))
       (setq g_r3 (vlax-get-property g_oex "Range" RangeD))
       (setq g_r4 (vlax-get-property g_oex "Range" RangeA))

       (vlax-put-property g_r0 "value2" (1+ point_number))
       (vlax-put-property g_r1 "value2" (rtos Y 2 3))
       (vlax-put-property g_r2 "value2" (rtos X 2 3))
       (vlax-put-property g_r3 "value2" (rtos Dist 2 3))
       (vlax-put-property g_r4 "value2" StAng)

       (setq point_number (1+ point_number))
    );end of repeat
    

    (if (and g_r0 (not (vlax-object-released-p g_r0)))
        (vlax-release-object g_r0))
    
    (if (and g_r1 (not (vlax-object-released-p g_r1)))
        (vlax-release-object g_r1))
    
    (if (and g_r2 (not (vlax-object-released-p g_r2)))
        (vlax-release-object g_r2))

    (if (and g_r3 (not (vlax-object-released-p g_r3)))
        (vlax-release-object g_r3))

    (if (and g_r4 (not (vlax-object-released-p g_r4)))
        (vlax-release-object g_r4))

    (if (and g_csh (not (vlax-object-released-p g_csh)))
        (vlax-release-object g_csh))

    (if (and g_shs (not (vlax-object-released-p g_shs)))
        (vlax-release-object g_shs))

    (if (and g_cb (not (vlax-object-released-p g_cb)))
        (vlax-release-object g_cb))

    (if (and g_wbs (not (vlax-object-released-p g_wbs)))
        (vlax-release-object g_wbs))
    
    (if (and g_oex (not (vlax-object-released-p g_oex)))
        (vlax-release-object g_oex))
    ;Обнуление использованных глобальных переменных
    (setq g_r0 nil g_r1 nil  g_r2 nil g_r3 nil g_r3 nil g_csh nil g_shs nil g_cb nil g_wbs nil g_oex nil)
    ;Сборка мусора
    (gc)
    
)





(defun geo_point_table ()
  (setq pnt nil)
  (setq nline 0)
  (setq rows nil);список для всех координат типа: ((x,y,z)(x,y,z)...)
  
  ;Запрос на ввод точек
  (while 
    (setq pnt (getpoint "\nУкажите координату: "))
    (setq nline (1+ nline));увеличиваем количество строк на 1
    ;формируем список с координатами
    (setq row pnt);списку row присваеваем список pnt с координатами выбранной точки
    (setq rows (append rows (list row) ));добавляем список row c коорд. выбранной точки в список со всеми коорд. rows    
  );while  

  ;Запрос на ввод коорд. левого верхнего угла таблицы  
  (setq InsertionPoint nil)                  
  (setq InsertionPoint (getpoint "\nУкажите координаты левого верхнего угла таблицы: "))

  ;Запоминаем значения сист.переменных                   
  (setq ORT (getvar "ORTHOMODE"));ORTHO                  
  (setq SN (getvar "SNAPMODE"));SNAP                     
  (setq OSN (getvar "OSMODE"));OSNAP
  (setq DIMZ (getvar "DIMZIN"));DIMZIN
  (setq TEXT (getvar "TEXTSTYLE"));TEXTSTYLE
  (setq COLOR(getvar "CECOLOR"));CECOLOR
  ;Задаём значения сист.переменным                       
  (setvar "ORTHOMODE" 0);ORTHO                           
  (setvar "SNAPMODE" 0);SNAP                             
  (setvar "OSMODE" 0);OSNAP                              
  (setvar "DIMZIN" 0);DIMZIN
  (setvar "CECOLOR" "251");CECOLOR

  (DrawLines InsertionPoint nline);создаём линии таблицы
  (setvar "CECOLOR" COLOR);CECOLOR
  (DrawText InsertionPoint nline 2.0 rows);создаём текст в таблице

  ;возвращаем знач. сист.переменных в начальное состояние
  (setvar "ORTHOMODE" ORT);ORTHO                         
  (setvar "SNAPMODE" SN);SNAP                            
  (setvar "OSMODE" OSN);OSNAP                            
  (setvar "DIMZIN" DIMZ);DIMZIN
  (setvar "TEXTSTYLE" TEXT);TEXTSTYLE

);_end defun geo-draw-table



(
defun DrawLines(InsertionPoint nline)
  ;InsertionPoint - точка вставки
  ;nline - количество строк
  (setq width 104 h 4);ширина таблицы\высота строк\
  
  ;чертим гор.линии шапки таблицы
  (setq xx (car InsertionPoint) yy (cadr InsertionPoint))
  (geo-add-line (list xx yy) (list (+ xx width) yy) acLnWtByLayer);первая линия, с началом в точке InsertionPoint
  (geo-add-line (list (+ xx 13) (- yy h)) (list (+ xx 57) (- yy h)) acLnWtByLayer);вторая линия  
  (geo-add-line (list xx (- yy 8)) (list (+ xx width) (- yy 8)) acLnWtByLayer);третья линия

  ;чертим гор. линии таблицы
  (setq yy (- yy 12))
  (repeat nline
    (geo-add-line (list xx yy) (list (+ xx width) yy) acLnWtByLayer)
    (setq yy (- yy h))
  );_end repeat

  ;чертим вертикальные линии таблицы
  (setq xx (car InsertionPoint) yy (cadr InsertionPoint))
  (geo-add-line (list xx yy) (list xx (- yy 8 (* h nline))) acLnWtByLayer);первая линия  
  (geo-add-line (list (+ xx 13) yy) (list (+ xx 13) (- yy 8 (* h nline))) acLnWtByLayer);вторая линия
  (geo-add-line (list (+ xx 35) (- yy h)) (list (+ xx 35) (- yy 8 (* h nline))) acLnWtByLayer);третья линия
  (geo-add-line (list (+ xx 57) yy) (list (+ xx 57) (- yy 8 (* h nline))) acLnWtByLayer);четвёртая линия 
  (geo-add-line (list (+ xx 74) yy) (list (+ xx 74) (- yy 8 (* h nline))) acLnWtByLayer);пятая линия
  (geo-add-line (list (+ xx 91) yy) (list (+ xx 91) (- yy 8 (* h nline))) acLnWtByLayer);шестая линия
  (geo-add-line (list (+ xx 104) yy) (list (+ xx 104) (- yy 8 (* h nline))) acLnWtByLayer);седьмая линия    

);_end defun DrawLines



(
defun DrawText(InsertionPoint nline h rows)
  ;InsertionPoint - коорд. левого верхнего угла таблицы
  ;nline - количество строк
  ;h - высота текста
  ;rows - список со всеми координатами типа: ((x,y,z)(x,y,z)...)
  
  ;Шапка таблицы
  ;(command "_STYLE" "Table(Geocad)" "Times New Roman" 0.0 1.0 0.0 "N" "N");создаём новый текст.стиль "Table(Geocad)"
  ;(setvar "TEXTSTYLE" "Table(Geocad)");TEXTSTYLE

  (setq xx (car InsertionPoint) yy (cadr InsertionPoint))
  (geo-add-text "Номер" (list (+ xx 2.5) (- yy 3)) h acAlignmentLeft 0)
  (geo-add-text "точки" (list (+ xx 3) (- yy 6)) h acAlignmentLeft 0)
  (geo-add-text "К О О Р Д И Н А Т Ы" (list (+ xx 21) (- yy 3)) h acAlignmentLeft 0)
  (geo-add-text "X" (list (+ xx 23) (- yy 7)) h acAlignmentLeft 0)
  (geo-add-text "Y" (list (+ xx 44.5) (- yy 7)) h acAlignmentLeft 0)
  (geo-add-text "Дир.углы" (list (+ xx 60) (- yy 4.5)) h acAlignmentLeft 0)
  (geo-add-text "Меры" (list (+ xx 79) (- yy 3)) h acAlignmentLeft 0)
  (geo-add-text "линий,м" (list (+ xx 77.5) (- yy 6)) h acAlignmentLeft 0)
  (geo-add-text "На" (list (+ xx 96) (- yy 3)) h acAlignmentLeft 0)
  (geo-add-text "точку" (list (+ xx 94) (- yy 6)) h acAlignmentLeft 0)

  ;Таблица
  (setq i 1);счётчик
  (setq nlist 0);список с коорд.(x,y,z) в списке со всеми коорд. 
  (repeat nline
    ;номера точек
    (geo-add-text (rtos i 2 0) (list (+ xx 6.5) (- yy 11)) h acAlignmentCenter 0);выводим в перв. столбец номер точки

    (if (= i nline) (setq i 0));если последняя точка, в последнем столбце для точек пишем начальную точку
    (geo-add-text (rtos (1+ i) 2 0) (list (+ xx 97.5) (- yy 11)) h acAlignmentCenter 0);выводим в последний столбец номер точки

    ;координаты X и Y
    (setq kx (nth 0 (nth nlist rows)));коорд. X
    (setq ky (nth 1 (nth nlist rows)));коорд. Y
    (geo-add-text (rtos ky 2 2) (list (+ xx 24) (- yy 11)) h acAlignmentCenter 0);выводим X\переворачиваем координаты
    (geo-add-text (rtos kx 2 2) (list (+ xx 46) (- yy 11)) h acAlignmentCenter 0);выводим Y\переворачиваем координаты
     
    ;Дир.углы
    (setq a1 (nth nlist rows));первая координата
    (setq a2 (nth (rem (1+ nlist) nline) rows));вторая координата
    
    (setq x1 (car a1) y1 (cadr a1));выбираем из списка координат а1 x и y
    (setq x2 (car a2) y2 (cadr a2));выбираем из списка координат а2 x и y    
    (setq k1 (list y1 x1));меняем x и y и заносим в список 
    (setq k2 (list y2 x2));меняем x и y и заносим в список 


    (setq ang (geo_get_angle k1 k2));вычисляем угол\переворачиваем координаты
    (setq stang (angtos ang 1 3));преобразуем угол в стороку с точностью 3
    (setq stang (vl-string-subst "° " "d" stang));заменяем символ d(град) на символ '° '
    (setq stang (vl-string-subst "' " "'" stang));заменяем символ '(мин) на символ '' '(c пробелом)
    (geo-add-text stang (list (+ xx 65.5) (- yy 11)) h acAlignmentCenter 0);выводим угол в град,мин,сек. 

    ;Расстояние
    (setq pnt1 (nth nlist rows));первая координата
    (setq pnt2 (nth (rem (1+ nlist) nline) rows));вторая координата
    (setq dist (geo_get_distance pnt1 pnt2))
    (geo-add-text (rtos dist 2 2) (list (+ xx 82.5) (- yy 11)) h acAlignmentCenter 0);выводим расстояние
  
    (setq i (1+ i));увеличиваем i на 1
    (setq yy (- yy 4));уменьшаем yy на 4
    (setq nlist (1+ nlist));увеличиваем nlist на 1
  )

  
);_end defun DrawText
;----------------------------------------------------------------------------------------------------------------------------

[hwd]

@ProPeller,
"нарисованная" таблица - это мусор. За это нужно ставить в угол, на горох.

[AlexV]

Сообщение от hwd @ProPeller, "нарисованная" таблица - это мусор. За это нужно ставить в угол, на горох.

Это предрассудки.. При наличии СПДС CS "нарисованная" таблица парой кликов можно перекинуть данные в эксель.. Да и другие пути есть, наверное. .
Другое дело, - у меня только с точками работает, а при выделении полилинии ничего не создает..

[hwd]

Сообщение от AlexV При наличии СПДС CS

Ставить софтину ради интерпретации рисованных таблиц - не самое рациональное решение и ни разу не оправдывает подобный способ "создания таблиц". В автокаде есть родной объект Table, которым и нужно пользоваться.

[ProPeller]

Сообщение от hwd @ProPeller, "нарисованная" таблица - это мусор. За это нужно ставить в угол, на горох.

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

[hwd]

Сообщение от ProPeller Не совсем я вас понял. А зачем вам "нарисованная" таблица? Я например пользуюсь этой программой для вывода в эксель.

Насколько я вижу, в обозначенном вами коде таблица как раз таки рисуется линиями: смотрите код функций DrawLines и DrawText.

[ProPeller]

Сообщение от hwd Насколько я вижу, в обозначенном вами коде таблица как раз таки рисуется линиями: смотрите код функций DrawLines и DrawText.

Да и черт с ним, эту часть программы я не использую. А вот часть программы с извлечением длин сегментов полилинии в эксель очень даже.

[AlexV]

Сообщение от ProPeller Да и черт с ним, эту часть программы я не использую. А вот часть программы с извлечением длин сегментов полилинии в эксель очень даже.

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

[ProPeller]

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

Я думаю что можно, но я пока не обладаю такими навыками владения лиспом =)