• Anton
  • Восстановленный участник
  • На форуме с 6 августа 2002г.
  • Сообщений: 42
  • Спасибо: 0

Тема: Экспорт координат X Y Z точек из AutoCada в Excel

Помогите пожалуйста с экспортом координат X Y Z точек из AutoCada в Excel

  • Slava
  • Восстановленный участник
  • На форуме с 2 ноября 2005г.
  • Сообщений: 42
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

(defun C:exs-dot()
  (setq nb(vl-remove-if 'listp
      (mapcar 'cadr (ssnamex (ssget '((0 . "point")))))
      )
  )
  (setq coor (mapcar '(lambda(x)
            (cdr(assoc 10 x))
            )
         (mapcar 'entget nb)
         )
  )
  (setq coor (mapcar '(lambda(y)
      (trans y 0 1)
      )
         coor))
  (setq fname(getfiled "Введите имя файла для записи" "" "xls" 1))
  (setq desc(open fname "w"))
  (foreach i coor
    (princ (strcat (rtos(car i)) "\t" (rtos (cadr i))"\t" (rtos (caddr i)) "\n")desc)
);foreach
  (close desc)
    (princ)
  )

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Попробуй вот это

(defun C:PUN (/          *aplexcel*      *books-colection*
        *excell-cells*  *new-book*      *sheet#1*
        *sheet-collection*        col
        header        iz_listo        punto_datos
        row
       )
;;; Written by  ALEJANDRO LEGUIZAMON —  http://arquingen.tripod.com.co
;;; edited by FATTY T.O.H. — FattyHallex@gmail.com
  (or (vl-load-com))
;;;  (setq punto_datos (defpoints))
  (setq punto_datos (pointscoord))
  (alert "Просто закрой Эксель")
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application")
  *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)
  *excell-cells*     (vlax-get-property *Sheet#1* "Cells")
  )
  (vla-put-visible *AplExcel* :vlax-true)
  (setq row 1)
  (setq col 1)
  (setq header '("X" "Y" "Z"))
  (repeat (length header)
    (vlax-put-property
      *excell-cells*
      "Item"
      row
      col
      (vl-princ-to-string (car header))
    )
    (setq header (cdr header))
    (setq col (1+ col))
  )
  (setq  row 2
  col 1
  )
  (repeat (length punto_datos)
    (setq iz_listo (car punto_datos))
    (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))
      (setq col (1+ col))
    )
    (setq punto_datos (cdr punto_datos))
    (setq col 1
    row (1+ row)
    )
  )
;;;Раскомментировать, если надо сохранить файл
;|
  (vlax-invoke-method
    *New-Book*
    'SaveAs
    (strcat (getvar "dwgprefix")
      (vl-string-right-trim ".dwg" (getvar "dwgname"))
    )
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
  )
  |;
  (vlax-release-object *excell-cells*)
  (vlax-release-object *Sheet#1*)
  (vlax-release-object *Sheet-Collection*)
  (vlax-release-object *New-Book*)
  (vlax-release-object *Books-Colection*)
  (vlax-release-object *AplExcel*)
  (setq *AplExcel* nil)
  (gc)
  (gc)
  (princ)
)
(prompt "\n\t\t***\tНабери в командной строке PUN \t***\n")
(princ)
;;;Ф-ция возвращает список координат точек (POINT)
(defun pointscoord ( / ssnab el lst)
  (setq ssnab (ssget "_X" '((0 . "POINT"))))
  (while (and ssnab
          (setq el (ssname ssnab 0))
          )
    (setq pt (cdr(assoc 10 (entget el)))
          lst (cons pt lst)
      )
    (setq ssnab (ssdel el ssnab))
    )
  (setq ssnab nil)
  lst
)

  • xaoc25
  • Восстановленный участник
  • На форуме с 15 октября 2006г.
  • Сообщений: 1
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Я сделал как указано - сохранил код с расширением lsp, поместидл в директорию с автокадом, загрузил файл функцией AutoLoisp и ничего не произошло..
Где искать exel-файл?

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Экспорт координат X Y Z точек из AutoCada в Excel

> xaoc25
Надо после загрузки вызвать команду Автокада. (набрать в командной строке то, что после С:)
Если это код > Slava (2006-04-11 15:47:53), то
exs-dot, если > VVA (2006-04-15 11:00:00), то PUN В чертеже должны быть отрисованы точки (POINT)

  • Откуда: Хабаровский / Комсомольск-на-А
  • На форуме с 17 ноября 2006г.
  • Сообщений: 40
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Мне была удобна следующая программка
(defun defpoints ()
  (setq lst nil)
  (setq loop T)
  (setq  pt  (getpoint "\nПервая точка :")
  lst (cons pt lst)
  )
  (while
    (setq pt (getpoint "\nСледующая точка :" pt))
     (if (null pt)
       (setq loop nil)
     )
     (setq lst (cons pt lst))
  )
  (reverse lst)
)
(defun C:PUN (/          *aplexcel*      *books-colection*
        *excell-cells*  *new-book*      *sheet#1*
        *sheet-collection*        col
        header        iz_listo        punto_datos
        row
       )
;;; Written by  ALEJANDRO LEGUIZAMON —  http://arquingen.tripod.com.co
;;; edited by FATTY T.O.H. — FattyHallex@gmail.com
  (or (vl-load-com))
  (setq punto_datos (defpoints))
  (alert "Просто закрой Эксель")
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application")
  *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)
  *excell-cells*     (vlax-get-property *Sheet#1* "Cells")
  )
  (vla-put-visible *AplExcel* :vlax-true)
  (setq row 1)
  (setq col 1)
  (setq header '("X" "Y" "Z"))
  (repeat (length header)
    (vlax-put-property
      *excell-cells*
      "Item"
      row
      col
      (vl-princ-to-string (car header))
    )
    (setq header (cdr header))
    (setq col (1+ col))
  )
  (setq  row 2
  col 1
  )
  (repeat (length punto_datos)
    (setq iz_listo (car punto_datos))
    (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))
      (setq col (1+ col))
    )
    (setq punto_datos (cdr punto_datos))
    (setq col 1
    row (1+ row)
    )
  )
  (vlax-invoke-method
    *New-Book*
    'SaveAs
    (strcat (getvar "dwgprefix")
      (vl-string-right-trim ".dwg" (getvar "dwgname"))
    )
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
  )
  (vlax-release-object *excell-cells*)
  (vlax-release-object *Sheet#1*)
  (vlax-release-object *Sheet-Collection*)
  (vlax-release-object *New-Book*)
  (vlax-release-object *Books-Colection*)
  (vlax-release-object *AplExcel*)
  (setq *AplExcel* nil)
  (gc)
  (gc)
  (princ)
)
(prompt "\n\t\t***\tНабери в командной строке PUN \t***\n")
(princ)
;|«Visual LISP© Format Options»
(72 2 50 2 nil "end of " 60 9 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;
Найдено на ветке
http://www.autocad.ru/cgi-bin/f1/board. … &pm=50
Но можно до 3-го знака после запятой? Координаты большие (100000.000,500000.000) и приходится переносить начало координат — тогда получается. Если координаты малы (1000.00,1000.00)то программа работает, если велики - округляет до метра.

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

> Владислав
Просто надо было использовать функцию RTOS
поскольку VL-PRINC-TO-STRING в предыдущей
программе для общих типов данных
(мой недочет)
см. выделенную строку

(defun defpoints ()
(setq lst nil)
(setq loop T)
(setq pt (getpoint "\nПервая точка :")
lst (cons pt lst)
)
(while
(setq pt (getpoint "\nСледующая точка :" pt))
(if (null pt)
(setq loop nil)
)
(setq lst (cons pt lst))
)
(reverse lst)
)
(defun C:PUN (/ *aplexcel* *books-colection*
*excell-cells* *new-book* *sheet#1*
*sheet-collection* col
header iz_listo punto_datos
row
)
;;; Written by ALEJANDRO LEGUIZAMON — http://arquingen.tripod.com.co
;;; edited by FATTY T.O.H. — FattyHallex@gmail.com
(or (vl-load-com))
(setq punto_datos (defpoints))
(alert "Просто закрой Эксель")
(setq *AplExcel* (vlax-get-or-create-object "Excel.Application")
*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)
*excell-cells* (vlax-get-property *Sheet#1* "Cells")
)
(vla-put-visible *AplExcel* :vlax-true)
(setq row 1)
(setq col 1)
(setq header '("X" "Y" "Z"))
(repeat (length header)
(vlax-put-property
*excell-cells*
"Item"
row
col
(vl-princ-to-string (car header))
)
(setq header (cdr header))
(setq col (1+ col))
)
(setq row 2
col 1
)
(repeat (length punto_datos)
(setq iz_listo (car punto_datos))
(repeat (length iz_listo)
(vlax-put-property
*excell-cells*
"Item"
row
col
[b][i](vl-princ-to-string (rtos (car iz_listo) 2 3)); 3 знака после запятой[/i][/b]
)
(setq iz_listo (cdr iz_listo))
(setq col (1+ col))
)
(setq punto_datos (cdr punto_datos))
(setq col 1
row (1+ row)
)
)
(vlax-invoke-method
*New-Book*
'SaveAs
(strcat (getvar "dwgprefix")
(vl-string-right-trim ".dwg" (getvar "dwgname"))
)
-4143
nil
nil
:vlax-false
:vlax-false
1
2
)
(vlax-release-object *excell-cells*)
(vlax-release-object *Sheet#1*)
(vlax-release-object *Sheet-Collection*)
(vlax-release-object *New-Book*)
(vlax-release-object *Books-Colection*)
(vlax-release-object *AplExcel*)
(setq *AplExcel* nil)
(gc)
(gc)
(princ)
)
(prompt "\n\t\t***\tНабери в командной строке PUN \t***\n")
(princ)
;|«Visual LISP© Format Options»
(72 2 50 2 nil "end of " 60 9 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;

~'J'~

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Экспорт координат X Y Z точек из AutoCada в Excel

> Владислав
Развитие этой программы
Опубликовано
https://www.caduser.ru/forum/topic31669.html

;|================== XLS ========================================
*  published https://www.caduser.ru/forum/topic31444.html
               https://www.caduser.ru/forum/topic31669.html
* 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")   |;
;|================== XLS ========================================
* Опубликовано https://www.caduser.ru/forum/topic31444.html
               https://www.caduser.ru/forum/topic31669.html
* Автор: Владимир Азарко 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 - новая книга
* Возврат: 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"))|;
(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)
(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))
;|=============== Команда COOR ================================================
;https://www.caduser.ru/forum/topic31669.html
EN:
   Export of coordinates of the specified points, the chosen objects: points, blocks, polylines, splines in a text file, Excel.
   Text file - txt, or csv. A rounding off of coordinates according to current adjustments of a command _UNITS (LUPREC !!!)
RUS:
Экспорт координат указанных точек, выбранных объектов: точек, блоков, полилиний, сплайнов в текстовый файл, ексел.
Текстовый файл - либо txt, либо csv. Округление координат в соответствии с текущими настройками команды _UNITS|;
(defun c:COOR(/ cFile curPt filPath objSet oFlag oldMode ptLst sFlag lw isRus)
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn (setq ls nil)
  (repeat (/ (length lst) num)(repeat num (setq ls(cons (car lst) ls)lst (cdr lst)))
  (setq ret (append ret (list (reverse ls))) ls nil)))) ret)
(defun PtCollect(SelSet)(mapcar 'cdr (mapcar '(lambda(x)(assoc 10 x))(mapcar 'entget
(vl-remove-if 'listp(mapcar 'cadr(ssnamex SelSet))))))); end of PtCollect
(defun PLCollect(SelSet / ret)
(foreach lw (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp(mapcar 'cadr(ssnamex SelSet))))
  (cond ((wcmatch (vla-get-ObjectName lw) "*Polyline")
    (setq ret (append ret (group-by-num (vlax-get lw 'Coordinates)
    (if (=(vla-get-ObjectName lw) "AcDbPolyline") 2 3)))))
       ((=(vla-get-ObjectName lw) "AcDbSpline")(setq ret (append ret (group-by-num
         (vlax-safearray->list(vlax-variant-value (vla-get-controlpoints lw)))  3))))
      (t nil))) ret)
  (vl-load-com)(setq isRus(= (getvar "SysCodePage") "ANSI_1251"))(if(not ptcol:mode)(setq ptcol:mode "Pick"))
  (initget "Указать Точка Блоки Полилиния Pick pOints Blocks poLyline _Pick pOints Blocks poLyline Pick pOints Blocks poLyline")
(setq oldMode ptcol:mode ptcol:mode
(getkword (if IsRus (strcat "\nВыберите режим [Указать/Точка/Блоки/Полилиния или сплайн] <"
(cadr (assoc ptcol:mode '(("Pick" "Указать")("pOints" "Указать")("Blocks" "Блоки")("poLyline" "Полилиния")))) ">: ")
          (strcat "\nSpecify mode [Pick/pOints/Blocks/poLyline or spline] <"ptcol:mode">: "))) ptLst nil)
(if(null ptcol:mode)(setq ptcol:mode oldMode))
(cond ((= "Pick" ptcol:mode)(setq curPt T)
       (while curPt (setq curPt(getpoint (if IsRus
         "\nУкажите точку или Enter завершения > " "\nPick point or Enter to continue > ")))
    (if curPt (setq ptLst(append ptLst(list (trans curPt 1 0))))))); end condition #1
      ((= "pOints" ptcol:mode)(if (not(setq objSet(ssget "_I" '((0 . "POINT")))))(progn
         (if IsRus (princ "\nВыберите точки и нажмите Enter ")(princ "\nSelect points and press Enter "))
     (setq objSet(ssget '((0 . "POINT"))))))(if objSet (setq ptLst(PtCollect objSet)))); end condition #2
      ((= "Blocks" ptcol:mode)(if (not(setq objSet(ssget "_I" '((0 . "INSERT")))))(progn
        (if IsRus(princ "\nВыберите блоки и нажмите Enter ")(princ "\nSelect blocks and press Enter "))
       (setq objSet(ssget '((0 . "INSERT"))))))(if objSet (setq ptLst(PtCollect objSet)))); end condition #3
      ((= "poLyline" ptcol:mode)(if (not(setq objSet(ssget "_I" '((0 . "*POLYLINE,SPLINE")))))(progn
        (if IsRus(princ "\nВыберите полилинии и нажмите Enter  ")(princ "\nSelect polyline and press Enter "))
       (setq objSet(ssget '((0 . "*POLYLINE,SPLINE"))))))(if objSet (setq ptLst(PLCollect objSet)))); end condition #4
); end cond
(if ptLst (progn (princ "\n+++++++ Coordinates list +++++++\n")(setq ptLst (mapcar '(lambda(x)(trans x 0 1)) ptLst))
(mapcar '(lambda(x)(princ(strcat "\n"(rtos(car x))","(rtos(cadr x))
(if(= 3(length x))(strcat ","(rtos(nth 2 x))) "")))) ptLst); end mapcar
(princ "\n\n+++++++++ End of list +++++++++")(initget "Файл Excel Не Text Excel Not _Text Excel Not Text Excel Not")
(setq sFlag (getkword (if IsRus "\nСохранить координаты в [Файл/Excel/Не сохранять] <Файл> : "
"\nSave coordinates to [Text file/Excel/Not save] <Text> : ")))
(if(null sFlag)(setq sFlag "Text"))
(cond ((and (= "Text" sFlag)(setq filPath
       (getfiled (if IsRus "Сохранение координат в текстовый файл" "Save Coordinates to Text File") "Coordinates.txt" "txt;csv" 33)))
       (setq cFile(open filPath "w"))(foreach ln ptLst (write-line (strcat (rtos(car ln))","(rtos(cadr ln))
         (if(= 3(length ln))(strcat ","(rtos(nth 2 ln))))) cFile))(close cFile)(initget "Yes No")
       (setq oFlag(getkword (if IsRus "\nОткрыть файл? [Yes/No] <No> : " "\nOpen text file? [Yes/No] <No> : " )))
       (if(= oFlag "Yes")(startapp "notepad.exe" filPath))); end condition #1
     ((= "Excel" sFlag)(xls (mapcar '(lambda(x)(mapcar 'rtos x)) ptLst) nil nil "COOR")); end condition #2
     (t nil)))) (princ)); end of c:COOR

Командная строка : COOR
Округление: в соответвие с настройками команды _UNITS (переменная LUPREC)
Установи LUPREC=3 - 3 знака после запятой
         LUPREC=2 - 2 знака после запятой
и т.д.
Помимо точек экспортирует координаты полилиний, сплайнов, блоков, уназанных мышью точек в файл, ексел, блокнот

  • Откуда: Хабаровский / Комсомольск-на-А
  • На форуме с 17 ноября 2006г.
  • Сообщений: 40
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

> Fatty
Теперь все прекрасно работает. Большое спасибо!

  • Откуда: Хабаровский / Комсомольск-на-А
  • На форуме с 17 ноября 2006г.
  • Сообщений: 40
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

> VVA
COOR и PUN - работают прекрасно. У первого даже поболее возможностей. Большое спасибо!

  • LiSS
  • Восстановленный участник
  • На форуме с 22 апреля 2008г.
  • Сообщений: 21
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

> VVA
А можно сделать так чтобы с дуг тоже снимались координаты (начала, конца и радиуса)?

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Развитие этих команд здесь:
http://dwg.ru/f/showthread.php?t=20509
COOR - экспорт координат
COORN -экспорт координат с нумерацией
COORT -экспорт координат с нумерацией, где номером считается ближайший к точке текст

> LiSS
В этих командах никак, так как радиус не точка :(

  • Откуда: Томск
  • На форуме с 25 января 2008г.
  • Сообщений: 152
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

если чесно Ваши версии даже не запускал, но уверен, что если сделать вывод через ADODB всё будет работать значительно быстрее...

  • На форуме с 11 мая 2010г.
  • Сообщений: 2
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

у меня имеется файл dwg, с изолиниями высот (топоповерхность). у полилиний отметки z  ноль, а в свойствах уровень разный. можно ли как-нибудь "вытащить" координаты линий x,y и этот уровень в отдельный файл?

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Иван, Попробуй снова команду COOR из ссылки в #12 (смотреть пост #7 ) Теперь должно брать Elevation в качестве Z

  • gomer
  • gomer
  • Активный участник
  • На форуме с 19 сентября 2008г.
  • Сообщений: 104
  • Спасибо: 3

Re: Экспорт координат X Y Z точек из AutoCada в Excel

todesengel пишет:

если сделать вывод через ADODB всё будет работать значительно быстрее...

А если в *.csv экспортировать кода на порядок меньше будет :D

  • Disney
  • Disney
  • Активный участник
  • Откуда: Сибирь / Новосибирск
  • На форуме с 28 февраля 2007г.
  • Сообщений: 471
  • Спасибо: 25

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Ну и я, в той же теме, свой код исправил #22.
В LWpoleline у меня сразу Elevation как Z использовался, а вот в 2Dpolyline я проглядел, думал раз есть третья координата, значит всё хорошо, ан нет, она почему-то всегда 0 в независимости от Elevation

  • На форуме с 11 мая 2010г.
  • Сообщений: 2
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Владимир Азарко пишет:

Иван,  Попробуй снова команду COOR из ссылки в #12 (смотреть пост #7 ) Теперь должно брать Elevation в качестве Z

Большое спасибо! всё работает

Ответ от Frum (изменено: Андрей, 8 июня 2010г. 13:28:15)

  • Frum
  • Участник
  • На форуме с 7 июня 2010г.
  • Сообщений: 3
  • Спасибо: 0

Re: Экспорт координат X Y Z точек из AutoCada в Excel

COOR создает *.csv файл не верно! Разделителем должна быть точка-с-запятой ; а не просто запятая. Так с запятой-разделителем получается все в первой колонке.
Я исправил текст программы простым поиском-заменой (в текстовом редакторе) "," на ";"
Итого - 4 замены.

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Андрей пишет:

Разделителем должна быть точка-с-запятой ; а не просто запятая.

Почитай про "классический" csv

Андрей пишет:

Так с запятой-разделителем получается все в первой колонке.

Это так, отношу это к глюку excell'a

Андрей пишет:

Я исправил текст программы простым поиском-заменой (в текстовом редакторе) "," на ";"

молодец. По ссылке в #15 так же лежат исправленные лиспы с "," на ";"

  • На форуме с 30 января 2011г.
  • Сообщений: 6
  • Спасибо: 1

Re: Экспорт координат X Y Z точек из AutoCada в Excel

VVA пишет:

Развитие этих команд здесь:
http://dwg.ru/f/showthread.php?t=20509
COOR  - экспорт координат
COORN  -экспорт координат с нумерацией
COORT  -экспорт координат с нумерацией, где номером считается ближайший к точке текст

Уважаемый VVA - постоянно пользуюсь Вашим лиспом, снятие координат с полилиний, точек, но вот появилась потребность снятия координат с мест пересечения полилиний(т.е. того места, где пересекаются 2-ве полилинии), полилинии и отрезка, и когда одну полилинию пересекают несколько полилиний, есть ли возможность дополнить Ваш лисп такими функциями, заранее благодарен

Ответ от fixo (изменено: fixo, 30 января 2011г. 22:45:05)

  • fixo
  • fixo
  • Активный участник
  • Откуда: СПб
  • На форуме с 7 февраля 2009г.
  • Сообщений: 869
  • Спасибо: 41

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Попробуй исправленный вариант (особо не гонял -только на 2-х различных
координатных системах)
Проверь сами координаты у меня на это не времени сейчас

(vl-load-com)
(defun C:PTXL    (/ *error*  countp datafile decs en ent filename fst hgt lstobj nump par points sp ss  textp tmp)
  (defun *error*    (msg)
  (if datafile
    (close datafile))
  
  (if msg
    (princ (strcat "\nError! " msg)))
    (command "_undo" "_end")
  
  (princ)
  )
  
  (defun emake-pt  (pt)
    (entmake
      (list
    (cons 0 "POINT")
    (cons 100 "AcDbEntity")
    (cons 100 "AcDbPoint")
    (cons 10 (trans pt 1 0));<--WCS
    (cons 8 "0")
    )
      )
    )

  (defun emake-mtext  (p1 p2 txt)
    (entmake
      (list
    (cons 0 "MTEXT")
    (cons 100 "AcDbEntity")
    (cons 100 "AcDbMText")    
    (cons 10 (trans p1 1 0) )
    (cons 40 (getvar "TEXTSIZE"))
    (cons 41 (abs (- (car p2) (car p1))))
    (cons 7 (getvar "TEXTSTYLE"))
    (cons 1 txt)
    (cons 71 4)
    (cons 72 5)
    (cons 73 1)

    )
      )
    )
(defun group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
    (repeat num (setq ls 
            (cons (car lst) ls)
          lst (cdr lst)))
    (setq ret (append ret (list (reverse ls)))
          ls nil)))
    )
ret
  )

  (defun str2lst  (str sep / pos)
    (if    (setq pos (vl-string-search sep str))
      (cons (substr str 1 pos)
        (str2lst
          (substr str (+ (strlen sep) pos 1))
          sep
          )
        )
      (list str)
      )
    )
  (command "_undo" "_begin")

  (if (setq ent (entsel "\nSelect first entity >> "))
    (if (setq ss (ssget ))
      (progn
    (vl-load-com)
    (setq fst (vlax-ename->vla-object (setq en (car ent))))
    (setq sp (vlax-curve-getclosestpointto fst (cadr ent))
          par (vlax-curve-getparamatpoint fst sp))
    (setq lstobj (mapcar 'vlax-ename->vla-object
                (vl-remove en (vl-remove-if 'listp
                   (mapcar 'cadr (ssnamex ss))))))

(setq points nil)    
  
  (setq filename (getfiled "Select a Points Data File"
                 (getvar "dwgprefix")
                 "csv"
                 1)
         )
    (if (not filename) (setq filename (strcat (getvar "dwgprefix")
               (vl-filename-base (getvar "dwgname"))
               ".csv")));<-- (TCXT
    
(foreach obj lstobj
     (setq tmp (vlax-invoke obj 'intersectwith fst 0));;(vl-catch-all-apply 'vlax-invoke(list fst 'intersectwith (car lstobj) 0))

     (if tmp
       (if (>(length tmp) 3)
       (setq points (append points (group-by-num tmp 3) ))
       (setq points (cons tmp points))
       ))
     )
(setq points (mapcar '(lambda(pt)(trans pt 0 1))     points))
  (initget 6)
  (setq decs (getint (strcat "\nPrecision <"(rtos (getvar 'dimdec)) "> : ")))
    (if (not decs)(setq decs (getvar 'dimdec))
  )
  (setq cnt nil start nil drawp nil)
  
  (initget "Yes No")
  (setq nump (getkword "\nAdd numbering? [Yes/No] <N> : "))

    (if (eq "Yes" nump)
      (progn
  (initget 6)
  (setq countp (getint "\nInitial number <1> : "))
    (if (not countp)   (setq cnt 1)(setq cnt countp))
    (setq start cnt))
  )
  
 (initget "Yes No")
  (setq textp (getkword "\nDraw the text? [Yes/No] <N> : "))
  (if (eq "Yes" textp)
      (progn
    (setq drawp T)
(initget 6)
  (setq hgt (getreal (strcat "\nText height <"(rtos (getvar 'dimtxt)) "> : ")))
    (if (not hgt)  (setq hgt (getvar 'dimtxt)))))


    
   (setq points  (vl-sort points '(lambda (a b)
               ((if (< par (/ (vlax-curve-getendparam fst) 2))
              >
              <
              )
            (vlax-curve-getdistatpoint fst(vlax-curve-getclosestpointto fst a))
            (vlax-curve-getdistatpoint fst(vlax-curve-getclosestpointto fst b)))))
         )
    
(setq datafile (open filename "W"))
(foreach pt  points
  (write-line
    
    (strcat (if cnt (strcat (itoa cnt) (chr 9))(chr 0))        
        (rtos (car pt) 2 decs)
        (chr 9)
        (rtos (cadr pt) 2 decs)
        (chr 9)
        (rtos (caddr pt) 2 decs))
    datafile)
  (setq cnt (1+ cnt))
  )        
(close datafile)
  
(gc)
(princ "\n Records were added..")   
(alert (strcat "The point records were saved into the file:\n" filename ))
(if drawp
  (progn
(setq cnt start)

(foreach pt  points

      (emake-pt (trans (trans pt  1 0) 0 1 t));<--WCS
    (emake-mtext
     (trans (trans (polar pt 0 (* hgt 2)) 1 0) 0 1 t);<--WCS
      (trans(trans (polar pt (/ pi 4) (* hgt 10)) 1 0)0 1 t);<--WCS
      (itoa cnt)
    )

  (setq cnt (1+ cnt))
  )


 
      (vl-cmdf "_.zoom" "_O" en ""
           "_.zoom" ".5x")
    )
  )
      )
    )
      )

  (princ)
  )
(prompt "\n\t***\tType PTXL to run program")

(prin1)

[FONT=Arial]~'J'~[/FONT]

  • На форуме с 30 января 2011г.
  • Сообщений: 6
  • Спасибо: 1

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Попробовал спасибо большое, почти то что нужно, есть пару нюансов, правда может я что то не так делал, но расматривается только 1 пересечение, точнее в файл csv выводится 1 пересечение(координата одного пересечения без разделителей) хотя подписываются несколько (сколько и указывал). то что спрашиввается точность это большой плюс. Возможно ли доработать данную программу и обьеденить ее с программой VVA?

  • fixo
  • fixo
  • Активный участник
  • Откуда: СПб
  • На форуме с 7 февраля 2009г.
  • Сообщений: 869
  • Спасибо: 41

Re: Экспорт координат X Y Z точек из AutoCada в Excel

qwerty пишет:

Попробовал спасибо большое, почти то что нужно, есть пару нюансов, правда может я что то не так делал, но расматривается только 1 пересечение, точнее в файл csv выводится 1 пересечение(координата одного пересечения без разделителей) хотя подписываются несколько (сколько и указывал). то что спрашиввается точность это большой плюс. Возможно ли доработать данную программу и обьеденить ее с программой VVA?

Попробуй еще раз: выбери сначала пересекаемый объект (полилинию/линию и тд)
затем выбери рамкой или иным способом все объекты пересекающие эту полилинию/линию (можно включать
даже те объекты которые просто расположены рядом и сам выбранный первый объект - они будут игнорироваться
в работе программы),после выбора этих объектов нажать Enter как обычно, далее следуй посказкам...

Возможно ли доработать данную программу и обьеденить ее с программой VVA

Это вопрос к VVA Если у него есть желание и время - у меня лично нет
Успехов :)

[FONT=Arial]~'J'~[/FONT]

Ответ от qwerty (изменено: qwerty, 30 января 2011г. 21:59:57)

  • На форуме с 30 января 2011г.
  • Сообщений: 6
  • Спасибо: 1

Re: Экспорт координат X Y Z точек из AutoCada в Excel

Так теперь разобрался, в чем проблема, во 1-ых если csv файл открывать в экселе то нет разделения м/у х и у, а если  тотже файл открыть в блокноте то там разделяются табуляцией, во 2-ых если после того как спрашивает Add numbering ответить нет, он спрашивает Draw the text и тоже ответить нет то записывается одна координата.
в командной строке пишет вот это.
Precision <2> : 4
Add numbering? [Yes/No] <N> :
Draw the text? [Yes/No] <N> :
Error! неверный тип аргумента: numberp: nil_undo Текущие настройки: Авто = Вкл,
Управление = Все, Объединить = Есть, Слой = Есть
Количество отменяемых операций или [Авто/Управление/Начало/Конец/Метка/Обратно]
<1>: _end

а если в отвечать Y,  то тогда все гуд


Precision <2> : 4
Add numbering? [Yes/No] <N> : Y
Initial number <1> :
Draw the text? [Yes/No] <N> : Y
Text height <2.5> : 3
Records were added.._.zoom

Да, автокад 2011, русский