[ronik710]

Здравствуйте.
А нет ли какого нибудь способа, что бы выделить все красные линии(могут иногда и полилиниями быть) и в отдельном файле эксель или уже в открытом файле эксель что бы он выдал длину каждой линии по порядку.

Например в файле если идти справа налево то получится
1-15301.0649
2-15309.6362
3-15318.2075
...
и тогдалие.

[Дима_]

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

[ronik710]

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

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

[Nike]

_dataextraction не поможет?

Для данного случая можно извлечь длину и какую-нибудь координату, например начало по Х и отсортировать по ней..

Я честно говоря думал снять координаты начала и конца каждой линии и потом в экселе с помощью формул получить длину линий.

Так тебе общую длину линий надо подсчитать?

[ronik710]

Сообщение от Nike _dataextraction не поможет? Для данного случая можно извлечь длину и какую-нибудь координату, например начало по Х и отсортировать по ней.. Так тебе общую длину линий надо подсчитать?

Я никогда не работал с "_dataextraction". Я не представляю что оно делает. Почитаю на досуге.

Я не уверен что они идут с приращением одной длинны. В начале может быть одно приращение, а потом оно может возрасти или уменьшиться.

Нет. Мне нужны длины каждой отдельной линии(в примере они выделены красным цветом)

[Nike]

А приращение значения не имеет. Берется координата начала отрезка по Х, а потом список сортируется по ее значению - от меньшего к большему (слева направо) или от большего к меньшему (справа налево)..
(см. пример в файле)

[Олег (jr.)]

Попробуй

Код:

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

;;-----------------------------   Lines to Excel   -------------------------------

(defun C:LTX(/ *error* a b cset el1 el2 leg ln1 ln2 lr1 lr2 mp1 mp2 pe1 pe2 ps1 ps2
	     pset sset col data en fname i ip output p1 p2 row rowlist ss tmp txt
	     xlapp xlbook xlbooks xlcells xlrange xlsheet xlsheets xlvariant ylist)
  
(defun *error* (msg)
  (if
    (vl-position
      msg
      '("console break"
	"Function cancelled"
	"quit / exit abort"
       )
    )
     (princ "Error!")
     (princ msg)
  )

  (princ)
)

  ;;;local defun
(defun setcelltext(cells row column value)
  (vl-catch-all-apply
    'vlax-put-property
    (list cells 'Item row column
	 (vlax-make-variant
	   (vl-princ-to-string value) 8)))
  )

(setq output nil)

(princ "\nВыбрать первую линию")
  (if (setq sset (ssget ":S" '((0 . "line"))))
    (progn
      (setq ln1 (ssname sset 0)
	    el1 ( entget ln1)
	   lr1 (cdr (assoc 8 el1)))
      (princ "\nВыбрать последнюю линию")
      (if
      (setq pset (ssget ":S" '((0 . "line"))))
      (progn
	(setq ln2 (ssname pset 0)
	    el2 ( entget ln2)
	   lr2 (cdr (assoc 8 el2)))
	(if (not (eq lr1 lr2)) (progn (alert "Линии разных слоев, отбой...")(exit)(princ)))
	
(setq ps1 (cdr (assoc 10 el1))
	    pe1 (cdr (assoc 11 el1)  )
      mp1 (mapcar '(lambda (a b) (/ (+ a b) 2))ps1 pe1)
      ps2 (cdr (assoc 10 el2))
	    pe2 (cdr (assoc 11 el2)  )
      mp2 (mapcar '(lambda (a b) (/ (+ a b) 2))ps2 pe2)
      )
(setq cset (ssget "_F" (list mp1 mp2) (list (cons 0  "line")(cons 8  lr1))))
	
(setq data nil)
	
(setq  i -1)
	
(repeat	(sslength cset)
  (setq	en   (ssname cset (setq i (1+ i)))
	leg   (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
	tmp  (list (itoa (+ i 1)) (rtos leg 2  2) en)
	data (cons tmp data)
	)
  )

(setq data (vl-sort data '(lambda (a b)
				   (< (distance mp1 (cdr (assoc 10 (entget (last a)))))
				      (distance mp1 (cdr (assoc 10 (entget (last b)))))
				      )
			    )
		    )
      )
	
(setq data (mapcar '(lambda(x)
		     (reverse (cdr (reverse x))))
		   data
		   )
      ) 

  (alert "Ждите...\nфайл сохранить вручную")
  (setq	xlapp	   (vlax-get-or-create-object "Excel.Application")
	xlbooks  (vlax-get-property xlapp 'Workbooks)
	xlbook	   (vlax-invoke-method xlbooks 'Add)
	xlsheets (vlax-get-property xlbook 'Sheets)
	xlsheet	   (vlax-get-property xlsheets 'Item 1)
	xlcells	   (vlax-get-property xlsheet 'Cells)
	)
  
  
(vla-put-visible xlapp :vlax-true)
(vl-catch-all-apply 'vlax-put-property (list xlapp 'ScreenUpdating :vlax-false))
(setq row 1)
(foreach item data
  (setq col 1)
  (foreach a item
    ;;(setcelltext xlcells row col (strcat "'" a));<-- если не поддерживает локальные настройки
    (setcelltext xlcells row col a)
    (setq col (1+ col))
  )
  (setq row (1+ row))
)

(setq xlrange (vl-catch-all-apply 'vlax-get-property (list xlsheet 'usedrange)))
(vl-catch-all-apply 'vlax-invoke-method (list xlrange 'Select))
(setq xlrange (vl-catch-all-apply 'vlax-get-property (list xlapp 'selection)))
(vl-catch-all-apply 'vlax-invoke-method (list xlrange 'borderaround nil nil nil nil))
(vl-catch-all-apply 'vlax-put-property (list xlapp 'screenupdating :vlax-true))
 ( vl-catch-all-apply 'vlax-put-property (list
   (vlax-get-property xlrange 'columns)
   'numberformat "@"))
  (vlax-invoke-method
   (vlax-get-property xlrange 'columns)
   'autofit)
  )))
    )
;;;(setq fname (strcat (getvar "dwgprefix")(vl-string-right-trim ".dwg" (getvar "dwgname"))))
;;;
;;;(vlax-invoke-method
;;;    xlbook
;;;    'SaveAs
;;;    fname 
;;;    -4143
;;;    nil
;;;    nil
;;;    :vlax-false
;;;    :vlax-false
;;;    1
;;;    2
;;;  )
;;;(vlax-invoke-method
;;;    xlbook 'Close)
;;;(vlax-invoke-method
;;;    xlapp 'Quit)
  (mapcar '(lambda (x)
	     (vl-catch-all-apply
	       '(lambda	()
		  (vlax-release-object x)
		)
	     )
	   )
	  (list xlcells xlsheet xlsheets xlbook xlbooks xlapp)
  )
  (setq  xlapp nil)
  (gc)(gc)(gc)
 
  (*error* nil)
  (princ)
  )
(prompt "\n\t\t***\tStart command with LTX\t***\n")
(princ)

(or (vl-load-com)
    (princ)     )
;;-----------------------------  eof Lines to Excel   -------------------------------

[ronik710]

Сообщение от Олег (jr.) Попробуй

Попробовал. Работает как то странно. Непонятно сколько надо ждать. Если ждать 1 секунду, то он не успевает все линии снять чтоли. Если ждать минуту и более. то выдает странные числа совсем не похожие то что мне нужно.
А нельзя ли сначала выделить те линии у которых я хочу узнать длину, потом первую линию, потом последнюю.
И сколько ждать надо? Должно же относительно все быстро работать. Доли секунды буквально. Или нет?

[Олег (jr.)]

замени этот кусок кода

Код:

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

(*error* nil)
  (princ)
)

на этот

Код:

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

(alert "Выполнено")
(*error* nil)
  (princ)
)

Тогда будешь знать когда программа завершена
Использовал для теста твой чертеж все
рвассчитывает корректно
Дальше сам

[ronik710]

Сообщение от Олег (jr.) замени этот кусок кода Тогда будешь знать когда программа завершена Использовал для теста твой чертеж все рвассчитывает корректно Дальше сам

А такой вопросик. Окно выполнено само должно появляться? Оно появляется только тогда, когда я жму "OK" когда висит откно "Ждите... файл сохранить вручную", само появляться не хочет.
Может система у меня нетакая? Я работаю на windows pro 64 разрядная и 2011 64 разрядный AutoCAD.

И второе. Когда я выбираю самую левую вертикальную линию и самую правую(Она не совсем вертикальная) Те если жму в окощке ОК"Ждите... файл сохранить вручную" через 2 секунды, то в экселе 24 значения, а если жать ОК через 30 секунд, то в экселе только около 7-ми значений. Это нормально?

[Олег (jr.)]

Для информации:
У меня следующие параметры- x64 ,Excel 2007 (licensed student release), Windows 7
проверено в AutoCAD 2009 / 2010(eng)
и везде работает, так что ничем помочь не могу

[ronik710]

Сообщение от Олег (jr.) Для информации: У меня следующие параметры- x64 ,Excel 2007 (licensed student release), Windows 7 проверено в AutoCAD 2009 / 2010(eng) и везде работает, так что ничем помочь не могу

Сегодня вечером дома попробую на 2007 автокаде. Может косяк в том что у меня AutoCAD 2011(eng)

[ronik710]

Сообщение от Олег (jr.) Для информации: У меня следующие параметры- x64 ,Excel 2007 (licensed student release), Windows 7 проверено в AutoCAD 2009 / 2010(eng) и везде работает, так что ничем помочь не могу

Выявил несколько закономерностей.
1) У меня окно которое приведено в рисунке не исчезает никогда. Оно исчезает только тогда, когда я жму кнопку "ОК",только тогда появляется окно выполнено. Это нормально?


2) Про ошибочные данные которые я говорил выше. Если выделять линии слева направо,то все хорошо и выдает все 85 элементов, а если выделять справа налево, то выдает непонятно что. Немогли бы Вы пояснить этот момент. Может справа налево нельзя показывать, а только слева направо надо?

[VVA]

Мой вариант. Особо не тестировал

Код:

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

(defun C:Len2XL (  / ss i lst)
  (vl-load-com)
  (and (setq ss (ssget))
       (setq i -1)
       (repeat (sslength ss)
	 (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
	 (if (vlax-property-available-p obj 'length)
	   (setq lst (cons (list(vla-get-Length obj)) lst))
	   )
	 )
       lst
       (xls (reverse lst) '("Length") nil "Length")
       )
       
  )
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
;|= EN ================= XLS ========================================
*  published http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31371zf
               http://www.caduser.ru/cgi-bin/f1/board.cgi?t=19833nl&page=2
               http://dwg.ru/f/showthread.php?p=201021
               http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31596eW
               http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31371zf
               http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31596eW
* posted by Vladimir Azarko (VVA)
* Purpose: Export of the list of data Data-list in Excell
*             It is exported to a new leaf of the current book.
              If the book is not present, it is created
* Arguments:
              Data-list - The list of lists of data (LIST) 
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Each list of a kind (Value1 Value2... VlalueN) enters the name in
                            a separate line in corresponding columns (Value1-A Value2-B and .т.д.)
                  header -  The list (LIST) headings or nil a kind (" Signature A " " Signature B "...)
                            If header nil, is accepted ("X" "Y" "Z")
                 Colhide -  The list of alphabetic names of columns to hide or nil - to not hide ("A" "C" "D") - to hide columns A, C, D
                 Name_list - The name of a new leaf of the active book or nil - is not present
* Return: nil
* Usage
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3"  "Col4") '("B") "test")   |;


;|= RUS ================= XLS ========================================
* Опубликовано http://www.caduser.ru/cgi-bin/f1/board.cgi?t=19833nl&page=2
               http://dwg.ru/f/showthread.php?p=201021
               http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31371zf
               http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31596eW
* Автор: Владимир Азарко aka VVA
* Назначение: Печать списка данных Data-list в Excell
*             Для вывода создается новый лист активной книги или
              создается новая книга.
              
* Аргументы:
              Data-list — список списков данных (LIST) вида
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Каждый список вида (Value1 Value2 ... VlalueN) записывается
                            в отдельную строку в соответствующие столбцы (Value1-A Value2-B и .т.д.)
                  header —  список (LIST) заголовков или nil вида ("Подпись A" "Подпись B" ...)
                            Если header nil, принимается ("X" "Y" "Z")
                 Colhide —  список буквенных названий стоблцов для скрытия или nil — не скрывать
                            ("A" "C" "D") — скрыть столбцы A, C, D
                 Name_list — имя нового листа активной книги или nil — нет ("")
Имя получается как конкатенация Имя_рисунка + Name_list + счетчик для уникальности
* Возврат: nil
* TIPS!!! : При передачи функции xls числовых вещественных данных нет необходимости проверять текущий системный
            разделитель целой и дробной части ("HKEY_CURRENT_USER\\Control Panel\\International" "sDecimal")
            Функцией на время вывода отключается использование в Excele системного разделителя, разделителем
            целой и дробной части устанавливается точка. После завершения ф-ции все восстанавливается.
Пример вызова
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Столбец1" "Столбец2" "Столбец3" "Столбец4") '("B") nil)
подробнее http://dwg.ru/f/showthread.php?p=183912
пример http://dwg.ru/f/showthread.php?p=201021
|;
(vl-load-com)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
              *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
                  (vl-filename-base(getvar "DWGNAME"))
                  (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
   col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14))))  
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(vlax-put-property *AplExcel* 'DisplayAlerts :vlax-false)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
    (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
    (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))

[ronik710]

Сообщение от VVA Мой вариант. Особо не тестировал

Работает хорошо. вот только выдал 1 неправильный результат.
Если смотреть в примере, то Длинные линии(Те ктоторые ниже) Значения выдаёт нормально.
Короткие линии (Та что выше) сначала выдает длинну самой левой линии(2803.03), а потом с самой правой попорядку.(2447.5...). В принципе не кртитично, можно руками переставить.
Пока только такие ошибки.