[Rus2007]

подскажите пожалуйста, имеем подписи точек на плане, можно ли получить список координат (например в Еxcel) в три колонки x,y,название точки

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

Подписями что выступает? Однострочный текст? Многострочный текст? Блок с атрибутом? Надо ли для многострочного текста снимать форматирование?
http://dwg.ru/f/showthread.php?t=4651
P.S. "И незачем так орать".

[Rus2007]

Подписями выступает однострочный текст

[VVA]

А точка на плане "плоская"? Z у нее 0 или реальная отметка?

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

А Z-координата не требуется...

[Rus2007]

точка и текст "плоский" Z=0

[VVA]

Пробуй

Код:

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

;|================== XLS ========================================
* Опубликовано http://www.autocad.ru/cgi-bin/f1/boa...19833nl&page=2
               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)|;
(vl-load-com)
(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)
(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)
(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))

(defun C:PTXL ( / ss lst pt dL lstp lstt ret Z)
  (vl-load-com)
  (initget 1)
  (setq dL (getreal "\nMax distance from point to text: "))
  (and
  (princ "\nSelect text and Point")
  (setq ss (ssget "_:L" '((0 . "TEXT,Point"))))
  (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (foreach en lst
    (if (= (cdr(assoc 0 (entget en))) "POINT")
      (setq lstp (cons en lstp))
      (setq lstt (cons en lstt))
      )
    )
  (foreach en lstp
    (setq pt (cdr(assoc 10 (entget en))))
    (setq pt (mapcar '+ pt '(0 0)))
    (setq lst (vl-remove-if '(lambda(txt)
          (< (distance pt
         (mapcar '+ (cdr(assoc 10 (entget txt)))
             '(0 0)))
      dL
      )
          )
  lstt
  )
   )
    (setq lst (vl-sort lst '(lambda(x y)
         (< (distance pt (mapcar '+ (cdr(assoc 10 (entget x)))  '(0 0)))
     (distance pt (mapcar '+ (cdr(assoc 10 (entget y)))  '(0 0))) 
      )
         )
         )
   )
    (setq Z (cdr(assoc 1 (entget (car lst)))))
    (setq Z (vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t" Z)))
    (setq Z (atof Z))
    (setq pt (append pt (list Z)))
    (setq ret (cons pt ret))
    )
  )
    (if ret (xls ret '("X" "Y" "Z") nil nil))
    (princ)
)

Команда PTXL.
Max distance from point to text - максимальное отклонение точки и текста.
Координаты текста берутся из поля 10 (выравнивание влево)
Если найдено несколько текстов с отклонением меньше Max distance, берется текст с наименьшим расстоянием.

[Rus2007]

так как я не специалист в Lispe, пытался запустить эту прогу, но ничего не получилось. Подскажите пожалуйста

[VVA]

Читай мою подпись:
Как использовать код на Лиспе читаем здесь

[Rus2007]

не получается выдает ошибку: no function definition: XLS

[VVA]

Скопируй код полностью из окна. Функция xls определена в самом верху

(defun xls ( Data-list

PS. Справа и внизу окна кода есть полоски, которые его (код) прокручивают.

[Rus2007]

БОЛЬШОЕ СПАСИБО! РАБОТАЕТ!!!