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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Создание графика в AutoCAD на основе txt или xls файла

Создание графика в AutoCAD на основе txt или xls файла

Ответ
Поиск в этой теме
Непрочитано 08.07.2008, 17:28 #1
Создание графика в AutoCAD на основе txt или xls файла
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,974

Имею txt файл. В нем запись такого содержания
3.2,0.2
9.2,1.5
15.2,-2.8
И так далее подобные строчки.
На основе этого файла надо в AutoCAD создать график.
При этом по оговоренным координатам расставляются блоки с именем “ Отметка графика”, затем эти же точки соединяются полигинией.
График начинается с абсолютной координаты 0,0.
В файле имею так же блок в котором сетка с отметками, думаю его присудствие не должно ни на что повлиять.
Файлик вот такой.ъ
Прошу помочь.
Заранее спасибо если кто ответит.

Вложения
Тип файла: dwg
DWG 2004
Таблицы отклонений.dwg (66.3 Кб, 22895 просмотров)

__________________
Блог

Последний раз редактировалось Red Nova, 17.07.2008 в 16:25.
Просмотров: 65361
 
Непрочитано 10.07.2008, 10:15
#2
_Eugene


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


На уровне идеи:
А что если добавить в начало файла строку 0,0. Затем создать из строк файла list. А далее 2 цикла: первый рисует полилинию, второй расставляет блоки.
_Eugene вне форума  
 
Автор темы   Непрочитано 10.07.2008, 10:42
#3
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Идею одобряю, сам в программировании ноль, надежда на помощь программистов.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 10.07.2008, 11:37
#4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,741


Попробуй (сам понимаешь, код не гонял вообще)
---
Добавлено:
Код можно немного укоротить, но делать лениво
---
Добавлено 2:
добавлен код graph-by-file-with-point - то же самое, но с запросом "базовой" точки (по #11). Вроде работало...
Вложения
Тип файла: lsp graph-by-file.LSP (4.9 Кб, 1105 просмотров)
Тип файла: lsp graph-by-file-with-point.LSP (5.4 Кб, 916 просмотров)
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.

Последний раз редактировалось Кулик Алексей aka kpblc, 10.07.2008 в 22:22.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 10.07.2008, 12:58
#5
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Спасибо что откликнулся, но пока не заработало

Цитата:
Command: (graph-by-file)
bad argument type: fixnump: "3.2,0.2"
Может в txt надо какие-то правила ввода соблюдать?
__________________
Блог
Red Nova вне форума  
 
Непрочитано 10.07.2008, 13:07
#6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,741


Не, это мой косяк. Исправил - см. #4
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 10.07.2008, 13:43
#7
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Опять не пошло
Цитата:
Command: (graph-by-file)
bad list: 0.2
__________________
Блог
Red Nova вне форума  
 
Непрочитано 10.07.2008, 13:59
#8
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,741


Вариант №3, надеюсь, уже последний. Извини, запарка у меня
Брать там же.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 10.07.2008, 14:16
#9
Ander822


 
Регистрация: 16.07.2007
Minsk
Сообщений: 84


У меня есть прога, которая строит графики по данным из екселя.
Тока она дома, а я на работе.
Ander822 вне форума  
 
Автор темы   Непрочитано 10.07.2008, 14:32
#10
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Кулик Алексей aka kpblc,
Браво. Все как надо. Большое спасибо.
Ander822,
Будешь дома выложи пожалста. Буду длагодарен.
__________________
Блог
Red Nova вне форума  
 
Автор темы   Непрочитано 10.07.2008, 17:57
#11
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Кулик Алексей aka kpblc,
А можно попросить сделать вариант команды с запросом указания относительного начала координат? Чтобы не двигать потом график каждый раз.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 10.07.2008, 21:10
#12
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,741


Да легко! См. #4
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 10.07.2008, 21:23
#13
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Неа, непрокатило
Цитата:
Command: (graph-by-file-with-point)

Начальная точка построения графика <0,0,0> : bad argument type: listp "2,2"
__________________
Блог
Red Nova вне форума  
 
Непрочитано 10.07.2008, 22:22
#14
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,741


Исправил. Код там же.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 10.07.2008, 22:55
#15
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Теперь работает спасибо.
Ради прикола сделал txt файл цифрового описания кошки, во вложении файл в котором надо строить (так как там есть блок с именем "отметка графика") и txt файл с координатами.
Вложения
Тип файла: rar График прикол.rar (33.6 Кб, 724 просмотров)
__________________
Блог
Red Nova вне форума  
 
Автор темы   Непрочитано 13.07.2008, 13:11
#16
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Кулик Алексей aka kpblc,
Прости что опять беспокою.
А можно переделать прожку под эксель? Если в эксель файле два столбика, первый соответствует координате Х, второй У.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 13.07.2008, 14:33
#17
-mavlin-


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


В даунлоаде вчера выложили такую прогу.
http://dwg.ru/dnl/4177
-mavlin- вне форума  
 
Автор темы   Непрочитано 13.07.2008, 16:35
#18
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


-mavlin- Хорошая прожка, спасибо, рисует даже координатные линии.В общем очень полезно.
Правда то что разработал Кулик Алексей aka kpblc несколько подточено под мои нужды, расставляет блоки по точкам графика, не запрашивает несколько раз различные данные. Так конкретно в моем случае быстрее и удобнее. Только я сразу не сообразил, что лучше в экселе исходные данные задавать.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 13.07.2008, 19:51
#19
-mavlin-


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


Так писалась она под собственные нужды.
-mavlin- вне форума  
 
Автор темы   Непрочитано 14.07.2008, 10:03
#20
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Все верно
__________________
Блог
Red Nova вне форума  
 
Непрочитано 15.07.2008, 03:33
#21
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


Цитата:
Сообщение от Red Nova Посмотреть сообщение
Только я сразу не сообразил, что лучше в экселе исходные данные задавать.
Замените в функции getfiled "txt" на "csv". Конечно это расширение гораздо удобнее.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 15.07.2008, 04:08
#22
Димас

джедай
 
Регистрация: 31.01.2005
Магадан
Сообщений: 460
<phrase 1=


Цитата:
Сообщение от KAI Посмотреть сообщение
Конечно это расширение гораздо удобнее.
Offtop: гораздо удобнее напрямую с экселя брать или с аксесса)
это я как пользователь утверждаю)
__________________
тут была подпись(
Димас вне форума  
 
Непрочитано 15.07.2008, 08:33
#23
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,741


Именно поэтому, а также учитывая, что у меня опыта работы с существующими файла Excel'a чрезвычайно мало, я не могу ничего написать...
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 15.07.2008, 17:59
#24
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Кулик Алексей aka kpblc,
Цитата:
Именно поэтому, а также учитывая, что у меня опыта работы с существующими файла Excel'a чрезвычайно мало, я не могу ничего написать...
Ну что же, и на том что есть большое спасибо.
KAI, Сам не сумею, если можешь сделай пожалста.
Димас, Честно говоря не очень понял. Что брать на прямую? Может ты имеешь ввиду копирование bmp графика?
__________________
Блог
Red Nova вне форума  
 
Непрочитано 16.07.2008, 01:32
#25
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


Цитата:
Сообщение от Red Nova Посмотреть сообщение
KAI, Сам не сумею, если можешь сделай пожалста.
1. Открыть файл LSP с нужной функцией
2. Найти строчку с функцией getfiled
3. Замнить в этой строке "txt" на "csv"
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Автор темы   Непрочитано 16.07.2008, 09:33
#26
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Ну поменял. Пользы пока нет. Зачем "csv" не очень понятно, расширение экселя ведь "xls".
__________________
Блог
Red Nova вне форума  
 
Непрочитано 16.07.2008, 10:05
#27
VVA

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


Red Nova, А ты создай csv файл и дважды щелкни по нему в проводнике. Посмотри кто его откроет.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.07.2008, 11:36
#28
VVA

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


Как-то была задача экспортировать точки и их описание из Excell в Автокад. На основе кода, выложенного здесь и опубликованного здесь. К нему прикрутил функцию Алексея graph-by-file-with-poin. Получилось такие команды:
Xl2PT - импорт точек из Excel в Автокад Столбец A - X; B - Y; C - Z; D - описание точки Высота текста - переменная TEXTSIZE
Xl2PL - построение LW полилинии по координатам столбцов A (X) и B (Y)

*** Добавлено
Грузить vlx файл

*** Обновлено 2011-11-21
Вложения
Тип файла: rar GetPointFormExcel.rar (24.7 Кб, 376 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 21.11.2011 в 12:05.
VVA вне форума  
 
Непрочитано 16.07.2008, 12:41
#29
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


>Кулик Алексей aka kpblc
Другой взгляд на рисование, без vla-add можно покороче...
Код:
[Выделить все]
(defun c:test (/ A B F L S)
 (if
  (and (setq f (getfiled "Укажите файл с точками графика" "" "txt" 0))
       (setq b (ssget ":S:E" '((0 . "INSERT"))))
       (setq b (assoc 2 (entget (ssname b 0))))
  ) ;_  and
  (progn
   (setq f (open f "r")
         l nil
   ) ;_  setq
   (while (setq s (read-line f))
    (setq
     l (cons (read (strcat "(" (vl-string-translate "," " " s) ")"))
             l
       ) ;_  cons
    ) ;_  setq
   ) ;_  while
   (close f)
   (entmakex (append (list '(0 . "LWPOLYLINE")
                           '(100 . "AcDbEntity")
                           '(410 . "Model")
                           '(100 . "AcDbPolyline")
                           (cons 90 (length l))
                     ) ;_  list
                     (mapcar '(lambda (a)
                               (setq a (cons 10 a))
                               (entmakex (list '(0 . "INSERT") b a))
                               a
                              ) ;_  lambda
                             l
                     ) ;_  mapcar
             ) ;_  append
   ) ;_  entmakex
   (princ)
  ) ;_  progn
 ) ;_  if
)
Елпанов Евгений вне форума  
 
Автор темы   Непрочитано 16.07.2008, 13:54
#30
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


VVA, По #27
Верно, Эксельофский формат. Но программа измененная как говорил KAI ничего не нарисовала.
По #28 не заработало. Хотя и не совсем то что я ищу.
Цитата:
Xl2PT - импорт точек из Excel в Автокад Столбец A - X; B - Y; C - Z; D - описание точки Высота текста - переменная TEXTSIZE
Xl2PL - построение LW полилинии по координатам столбцов A (X) и B (Y)
Наверное второй командой ты хотел написать (XL_GET), хотя она тоже результата не дала.

Елпанов Евгений, А можно такую но с перламутровыми пуговицами? В смысле для ексель.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 16.07.2008, 14:27
#31
VVA

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


Там есть диалоговые окна (dcl файл). Они должны находится в путях поиска Автокада. Иначе не отработает диалог
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.07.2008, 14:59
#32
VVA

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


Обновил #28 Собрал все в vlx файл + пример excell
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.07.2008, 15:16
#33
Rus2007


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


Цитата:
Xl2PL - построение LW полилинии по координатам столбцов A (X) и B (Y)
А задать масштаб можно?
Rus2007 вне форума  
 
Непрочитано 16.07.2008, 15:17
#34
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Елпанов Евгений, А можно такую но с перламутровыми пуговицами? В смысле для ексель.
нет проблем - добавил свою старенькую функцию чтения из экселя...
Из плюсов - читает экселевские файлы, даже если эксель не установлен.
Если в экселе есть несколько листов, точнее есть данные в нескольких листах, то будет создано несколько графиков, по одному на каждый лист.
Из ограничений - я не парился с адресацией данных в экселе, т.е для отрисовки берутся два первых попавшихся столбца с данными и предполагается, что в них числа...
Код:
[Выделить все]
(defun GET_xl (tbl / ADOCONNECT ADORECORDSET LST)
              ;|
     GET_XL.LSP
     created 21-04-2006
     last edit 19-02-2007
     Created by Elpanov Evgeny
     
     842@list.ru
     elpanov@gmail.com

Data reading from Microsoft Excel not using Excel.
This code, can read diverse data from all tables.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls")

 USAGE:
 (GET_xl tbl)

 RETURN VFALUES
 The list of all pages in a file with all data
|;
 (defun rec-rem-dupl (lst)
  (if lst
   (cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
  ) ;_  if
 ) ;_  defun
 (setq ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
       ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
 ) ;_  setq
 (if
  (not (vl-catch-all-error-p
        (vl-catch-all-apply
         (function vlax-invoke-method)
         (list ADOConnect
               "Open"
               (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
                       tbl
                       ";Extended Properties=;Excel 8.0;HDR=No"
               ) ;_  strcat
               "admin"
               ""
               nil
         ) ;_  list
        ) ;_  vl-catch-all-apply
       ) ;_  vl-catch-all-error-p
  ) ;_  not
  (progn (setq lst
               (mapcar
                (function (lambda (l / i c)
                           (vlax-invoke-method
                            ADORecordset
                            "Open"
                            (strcat "SELECT * FROM [" l "]")
                            ADOConnect
                            1
                            3
                            nil
                           ) ;_  vlax-invoke-method
                           (setq i
                                 (length
                                  (car (vlax-safearray->list
                                        (vlax-variant-value
                                         (vlax-invoke-method ADORecordset "GetRows" 65535) ;_  vlax-invoke-method
                                        ) ;_  vlax-variant-value
                                       ) ;_  vlax-safearray->list
                                  ) ;_  car
                                 ) ;_  length
                           ) ;_  setq
                           (vlax-invoke-method ADORecordset "Close")
                           (while (not (zerop i))
                            (vlax-invoke-method
                             ADORecordset
                             "Open"
                             (strcat "SELECT * FROM ["
                                     l
                                     "a"
                                     (itoa i)
                                     ":IV"
                                     (itoa i)
                                     "]"
                             ) ;_  strcat
                             ADOConnect
                             1
                             3
                             nil
                            ) ;_  vlax-invoke-method
                            (setq c (cons
                                     (car
                                      (apply
                                       (function mapcar)
                                       (cons
                                        'list
                                        (mapcar
                                         (function
                                          (lambda (a)
                                           (mapcar
                                            (function (lambda (b) (vlax-variant-value b)) ;_  lambda
                                            ) ;_  function
                                            a
                                           ) ;_  mapcar
                                          ) ;_  lambda
                                         ) ;_  function
                                         (vlax-safearray->list
                                          (vlax-variant-value
                                           (vlax-invoke-method
                                            ADORecordset
                                            "GetRows"
                                            65535
                                           ) ;_  vlax-invoke-method
                                          ) ;_  vlax-variant-value
                                         ) ;_  vlax-safearray->list
                                        ) ;_  mapcar
                                       ) ;_  cons
                                      ) ;_  apply
                                     ) ;_  car
                                     c
                                    ) ;_  cons
                                  i (1- i)
                            ) ;_  setq
                            (vlax-invoke-method ADORecordset "Close")
                           ) ;_  while
                           (if (equal c '((nil) (nil)))
                            (list l)
                            (cons l c)
                           ) ;_  if
                          ) ;_  lambda
                ) ;_  function
                (mapcar
                 (function (lambda (x)
                            (if (= (substr x 1 1) "'")
                             (substr x 2 (- (strlen x) 2))
                             x
                            ) ;_  if
                           ) ;_  lambda
                 ) ;_  function
                 (rec-rem-dupl
                  (caddr
                   (mapcar (function (lambda (a)
                                      (mapcar (function vlax-variant-value) a) ;_  mapcar
                                     ) ;_  lambda
                           ) ;_  function
                           (vlax-safearray->list
                            (vlax-variant-value
                             (vlax-invoke-method
                              (vlax-invoke-method ADOConnect "OpenSchema" 4) ;_  vlax-invoke-method
                              "GetRows"
                              65535
                             ) ;_  vlax-invoke-method
                            ) ;_  vlax-variant-value
                           ) ;_  vlax-safearray->list
                   ) ;_  apply
                  ) ;_  caddr
                 ) ;_  rec-rem-dupl
                ) ;_  mapcar
               ) ;_  mapcar
         ) ;_  setq
         (vlax-invoke-method ADOConnect "Close")
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         lst
  ) ;_  progn
  (progn
   (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close"))
   (vlax-release-object ADORecordset)
   (vlax-release-object ADOConnect)
   (setq ADORecordset nil
         ADOConnect nil
   ) ;_  setq
   nil
  ) ;_  progn
 ) ;_  if
)
(defun c:test (/ A B F L)
 ;;пример для экселя...
 (if
  (and (setq f (getfiled "Укажите файл с точками графика" "" "xls" 0))
       (setq b (ssget ":S:E" '((0 . "INSERT"))))
       (setq b (assoc 2 (entget (ssname b 0))))
  ) ;_  and
  (progn
   (setq l (GET_xl f))
   (foreach x (mapcar 'cdr l)
    (if x
     (entmakex (append (list '(0 . "LWPOLYLINE")
                             '(100 . "AcDbEntity")
                             '(410 . "Model")
                             '(100 . "AcDbPolyline")
                             (cons 90 (length x))
                       ) ;_  list
                       (mapcar '(lambda (a)
                                 (setq a (list 10 (car a) (cadr a)))
                                 (entmakex (list '(0 . "INSERT") b a))
                                 a
                                ) ;_  lambda
                               x
                       ) ;_  mapcar
               ) ;_  append
     ) ;_  entmakex
    ) ;_  if
   ) ;_  foreach
   (princ)
  ) ;_  progn
 ) ;_  if
) ;_  defun

Последний раз редактировалось Елпанов Евгений, 16.07.2008 в 15:19. Причина: правил теги
Елпанов Евгений вне форума  
 
Непрочитано 16.07.2008, 15:25
#35
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Rus2007 Посмотреть сообщение
А задать масштаб можно?
масштаб задать не сложно, но понадобится указывать базовую точку, относительно которой нужно масштабировать и задать масштаб, т.е. никакой автоматизации, по сравнением с обычным вызовом функции масштабирования... Вот если масштабировать всегда относительно известной или вычисляемой точки, например, относительно угла габаритного контейнера или начала координат, то это можно делать и автоматом...
Елпанов Евгений вне форума  
 
Непрочитано 16.07.2008, 16:48
#36
VVA

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


Rus2007, Или имеется ввиду разный масштаб по X и Y?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.07.2008, 18:09
#37
Rus2007


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


Да масштаб по Х один, по У другой.
Rus2007 вне форума  
 
Непрочитано 16.07.2008, 18:18
#38
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Rus2007 Посмотреть сообщение
Да масштаб по Х один, по У другой.
вариант для экселя, с запросом масштабов...
Код:
[Выделить все]
(defun GET_xl (tbl / ADOCONNECT ADORECORDSET LST)
              ;|
     GET_XL.LSP
     created 21-04-2006
     last edit 19-02-2007
     Created by Elpanov Evgeny
     
     842@list.ru
     elpanov@gmail.com

Data reading from Microsoft Excel not using Excel.
This code, can read diverse data from all tables.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls")

 USAGE:
 (GET_xl tbl)

 RETURN VFALUES
 The list of all pages in a file with all data
|;
 (defun rec-rem-dupl (lst)
  (if lst
   (cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
  ) ;_  if
 ) ;_  defun
 (setq ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
       ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
 ) ;_  setq
 (if
  (not (vl-catch-all-error-p
        (vl-catch-all-apply
         (function vlax-invoke-method)
         (list ADOConnect
               "Open"
               (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
                       tbl
                       ";Extended Properties=;Excel 8.0;HDR=No"
               ) ;_  strcat
               "admin"
               ""
               nil
         ) ;_  list
        ) ;_  vl-catch-all-apply
       ) ;_  vl-catch-all-error-p
  ) ;_  not
  (progn (setq
          lst (mapcar
               (function (lambda (l / i c)
                          (vlax-invoke-method
                           ADORecordset
                           "Open"
                           (strcat "SELECT * FROM [" l "]")
                           ADOConnect
                           1
                           3
                           nil
                          ) ;_  vlax-invoke-method
                          (setq i
                                (length
                                 (car (vlax-safearray->list
                                       (vlax-variant-value
                                        (vlax-invoke-method ADORecordset "GetRows" 65535)
                                       ) ;_  vlax-variant-value
                                      ) ;_  vlax-safearray->list
                                 ) ;_  car
                                ) ;_  length
                          ) ;_  setq
                          (vlax-invoke-method ADORecordset "Close")
                          (while (not (zerop i))
                           (vlax-invoke-method
                            ADORecordset
                            "Open"
                            (strcat "SELECT * FROM ["
                                    l
                                    "a"
                                    (itoa i)
                                    ":IV"
                                    (itoa i)
                                    "]"
                            ) ;_  strcat
                            ADOConnect
                            1
                            3
                            nil
                           ) ;_  vlax-invoke-method
                           (setq c (cons
                                    (car
                                     (apply
                                      (function mapcar)
                                      (cons
                                       'list
                                       (mapcar
                                        (function
                                         (lambda (a)
                                          (mapcar
                                           (function (lambda (b) (vlax-variant-value b))
                                           ) ;_  function
                                           a
                                          ) ;_  mapcar
                                         ) ;_  lambda
                                        ) ;_  function
                                        (vlax-safearray->list
                                         (vlax-variant-value
                                          (vlax-invoke-method
                                           ADORecordset
                                           "GetRows"
                                           65535
                                          ) ;_  vlax-invoke-method
                                         ) ;_  vlax-variant-value
                                        ) ;_  vlax-safearray->list
                                       ) ;_  mapcar
                                      ) ;_  cons
                                     ) ;_  apply
                                    ) ;_  car
                                    c
                                   ) ;_  cons
                                 i (1- i)
                           ) ;_  setq
                           (vlax-invoke-method ADORecordset "Close")
                          ) ;_  while
                          (if (equal c '((nil) (nil)))
                           (list l)
                           (cons l c)
                          ) ;_  if
                         ) ;_  lambda
               ) ;_  function
               (mapcar
                (function (lambda (x)
                           (if (= (substr x 1 1) "'")
                            (substr x 2 (- (strlen x) 2))
                            x
                           ) ;_  if
                          ) ;_  lambda
                ) ;_  function
                (rec-rem-dupl
                 (caddr
                  (mapcar
                   (function
                    (lambda (a) (mapcar (function vlax-variant-value) a))
                   ) ;_  function
                   (vlax-safearray->list
                    (vlax-variant-value
                     (vlax-invoke-method
                      (vlax-invoke-method ADOConnect "OpenSchema" 4)
                      "GetRows"
                      65535
                     ) ;_  vlax-invoke-method
                    ) ;_  vlax-variant-value
                   ) ;_  vlax-safearray->list
                  ) ;_  apply
                 ) ;_  caddr
                ) ;_  rec-rem-dupl
               ) ;_  mapcar
              ) ;_  mapcar
         ) ;_  setq
         (vlax-invoke-method ADOConnect "Close")
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         lst
  ) ;_  progn
  (progn
   (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close"))
   (vlax-release-object ADORecordset)
   (vlax-release-object ADOConnect)
   (setq ADORecordset nil
         ADOConnect nil
   ) ;_  setq
   nil
  ) ;_  progn
 ) ;_  if
) ;_  defun
(defun c:test (/ A B F L)
 ;;пример для экселя...
 ;; c запросом масштаба.
 (if
  (and (setq f (getfiled "Укажите файл с точками графика" "" "xls" 0))
       (setq b (ssget ":S:E" '((0 . "INSERT"))))
       (setq b (assoc 2 (entget (ssname b 0))))
  ) ;_  and
  (progn
   (setq s (mapcar '(lambda (x)
                     (if x
                      x
                      1
                     ) ;_  if
                    ) ;_  lambda
                   (list (getreal "\nВведите масштаб по Х [1]:  ")
                         (getreal "\nВведите масштаб по Y [1]:  ")
                   ) ;_  list
           ) ;_  mapcar
   ) ;_  setq
   (setq l (GET_xl f))
   (foreach x (mapcar 'cdr l)
    (if x
     (entmakex
      (append
       (list '(0 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(410 . "Model")
             '(100 . "AcDbPolyline")
             (cons 90 (length x))
       ) ;_  list
       (mapcar
        '(lambda (a)
          (setq a (list 10 (* (car s) (car a)) (* (cadr s) (cadr a))))
          (entmakex (list '(0 . "INSERT") b a))
          a
         ) ;_  lambda
        x
       ) ;_  mapcar
      ) ;_  append
     ) ;_  entmakex
    ) ;_  if
   ) ;_  foreach
   (princ)
  ) ;_  progn
 ) ;_  if
) ;_  defun
Елпанов Евгений вне форума  
 
Непрочитано 16.07.2008, 18:28
#39
Rus2007


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


После выбора файла эксель выдает
; ошибка: неверная строка режима ssget

Последний раз редактировалось Rus2007, 16.07.2008 в 18:34.
Rus2007 вне форума  
 
Непрочитано 16.07.2008, 18:35
#40
VVA

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


Rus2007,
Строчка
Код:
[Выделить все]
(setq b (ssget ":S:E" '((0 . "INSERT"))))
Должна быть записана так
Код:
[Выделить все]
(setq b (ssget "_:S:E" '((0 . "INSERT"))))
Добавь _ перед :S:E
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.07.2008, 18:35
#41
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Rus2007 Посмотреть сообщение
После команды: после выбора файла эксель выдает
; ошибка: неверная строка режима ssget
попробуй заменить строку на
Код:
[Выделить все]
(setq b (ssget ":S" '((0 . "INSERT"))))
а вообще, какой у тебя автокад? Случаем не 2000 или 2002?
Елпанов Евгений вне форума  
 
Непрочитано 16.07.2008, 18:38
#42
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


VVA,
Точно, это проблемы локализации, точнее отсутствия в моем коде...
Можно изменить строку на:
Код:
[Выделить все]
(setq b (ssget "_+.:S" '((0 . "INSERT"))))
ps. прошу извинить, я не особенно парился над программой..
Елпанов Евгений вне форума  
 
Непрочитано 16.07.2008, 18:39
#43
VVA

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


Елпанов Евгений, В локализованных версиях Автокада в режимах ssget нужно добавлять _.
(ssget "_:S:E:L") и. т.п. модификации работать будут

*** Добавлено

Кстати насчет плюса я пока не въехал в его нужность.
Вариант (ssget "_:S:E:L") работает и без него
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.07.2008, 18:44
#44
Rus2007


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


Цитата:
а вообще, какой у тебя автокад? Случаем не 2000 или 2002?
у меня 2004
Rus2007 вне форума  
 
Непрочитано 16.07.2008, 18:51
#45
Rus2007


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


Теперь появляется сообщение: выберите обьекты.
Ничего не понимаю ???
Rus2007 вне форума  
 
Автор темы   Непрочитано 16.07.2008, 19:43
#46
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Елпанов Евгений,
Пока запустить не получается.
Я пробовал так
Цитата:
Command: (GET_xl)
; error: too few arguments
Еще хотел уточнить кое что. Мне в конечном итоге нужен лисп как второй с поста 4, только для экселя. Надеюсь это возможно.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 16.07.2008, 19:46
#47
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Rus2007 Посмотреть сообщение
Теперь появляется сообщение: выберите обьекты.
Ничего не понимаю ???
Подразумевается, что будет указан блок, копии которого нужно будет вставить во все вершины...
Елпанов Евгений вне форума  
 
Непрочитано 17.07.2008, 12:18
#48
Rus2007


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


ошибка: no function definition: VLAX-GET-OR-CREATE-OBJECT
Rus2007 вне форума  
 
Непрочитано 17.07.2008, 12:22
#49
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Код:
[Выделить все]
(defun GET_xl (tbl / ADOCONNECT ADORECORDSET LST)
              ;|
     GET_XL.LSP
     created 21-04-2006
     last edit 19-02-2007
     Created by Elpanov Evgeny
     
     842@list.ru
     elpanov@gmail.com

Data reading from Microsoft Excel not using Excel.
This code, can read diverse data from all tables.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls")

 USAGE:
 (GET_xl tbl)

 RETURN VFALUES
 The list of all pages in a file with all data
|;
 (defun rec-rem-dupl (lst)
  (if lst
   (cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
  ) ;_  if
 ) ;_  defun
 (setq ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
       ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
 ) ;_  setq
 (if
  (not (vl-catch-all-error-p
        (vl-catch-all-apply
         (function vlax-invoke-method)
         (list ADOConnect
               "Open"
               (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
                       tbl
                       ";Extended Properties=;Excel 8.0;HDR=No"
               ) ;_  strcat
               "admin"
               ""
               nil
         ) ;_  list
        ) ;_  vl-catch-all-apply
       ) ;_  vl-catch-all-error-p
  ) ;_  not
  (progn (setq
          lst (mapcar
               (function (lambda (l / i c)
                          (vlax-invoke-method
                           ADORecordset
                           "Open"
                           (strcat "SELECT * FROM [" l "]")
                           ADOConnect
                           1
                           3
                           nil
                          ) ;_  vlax-invoke-method
                          (setq i
                                (length
                                 (car (vlax-safearray->list
                                       (vlax-variant-value
                                        (vlax-invoke-method ADORecordset "GetRows" 65535)
                                       ) ;_  vlax-variant-value
                                      ) ;_  vlax-safearray->list
                                 ) ;_  car
                                ) ;_  length
                          ) ;_  setq
                          (vlax-invoke-method ADORecordset "Close")
                          (while (not (zerop i))
                           (vlax-invoke-method
                            ADORecordset
                            "Open"
                            (strcat "SELECT * FROM ["
                                    l
                                    "a"
                                    (itoa i)
                                    ":IV"
                                    (itoa i)
                                    "]"
                            ) ;_  strcat
                            ADOConnect
                            1
                            3
                            nil
                           ) ;_  vlax-invoke-method
                           (setq c (cons
                                    (car
                                     (apply
                                      (function mapcar)
                                      (cons
                                       'list
                                       (mapcar
                                        (function
                                         (lambda (a)
                                          (mapcar
                                           (function (lambda (b) (vlax-variant-value b))
                                           ) ;_  function
                                           a
                                          ) ;_  mapcar
                                         ) ;_  lambda
                                        ) ;_  function
                                        (vlax-safearray->list
                                         (vlax-variant-value
                                          (vlax-invoke-method
                                           ADORecordset
                                           "GetRows"
                                           65535
                                          ) ;_  vlax-invoke-method
                                         ) ;_  vlax-variant-value
                                        ) ;_  vlax-safearray->list
                                       ) ;_  mapcar
                                      ) ;_  cons
                                     ) ;_  apply
                                    ) ;_  car
                                    c
                                   ) ;_  cons
                                 i (1- i)
                           ) ;_  setq
                           (vlax-invoke-method ADORecordset "Close")
                          ) ;_  while
                          (if (equal c '((nil) (nil)))
                           (list l)
                           (cons l c)
                          ) ;_  if
                         ) ;_  lambda
               ) ;_  function
               (mapcar
                (function (lambda (x)
                           (if (= (substr x 1 1) "'")
                            (substr x 2 (- (strlen x) 2))
                            x
                           ) ;_  if
                          ) ;_  lambda
                ) ;_  function
                (rec-rem-dupl
                 (caddr
                  (mapcar
                   (function
                    (lambda (a) (mapcar (function vlax-variant-value) a))
                   ) ;_  function
                   (vlax-safearray->list
                    (vlax-variant-value
                     (vlax-invoke-method
                      (vlax-invoke-method ADOConnect "OpenSchema" 4)
                      "GetRows"
                      65535
                     ) ;_  vlax-invoke-method
                    ) ;_  vlax-variant-value
                   ) ;_  vlax-safearray->list
                  ) ;_  apply
                 ) ;_  caddr
                ) ;_  rec-rem-dupl
               ) ;_  mapcar
              ) ;_  mapcar
         ) ;_  setq
         (vlax-invoke-method ADOConnect "Close")
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         lst
  ) ;_  progn
  (progn
   (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close"))
   (vlax-release-object ADORecordset)
   (vlax-release-object ADOConnect)
   (setq ADORecordset nil
         ADOConnect nil
   ) ;_  setq
   nil
  ) ;_  progn
 ) ;_  if
) ;_  defun
(defun c:test (/ A B F L)
 ;;пример для экселя...
 ;; c запросом масштаба и автоматическим созданием блоков отметок.
 (vl-load-com)
 (if (setq f (getfiled "Укажите файл с точками графика" "" "xls" 0))
  (progn
   (if (null (tblobjname "BLOCK" "Отметка графика"))
    (mapcar 'entmakex
            '(((0 . "BLOCK")
               (100 . "AcDbEntity")
               (67 . 0)
               (8 . "0")
               (100 . "AcDbBlockBegin")
               (70 . 0)
               (10 0.0 0.0 0.0)
               (2 . "Отметка графика")
               (1 . "")
              )
              ((0 . "HATCH")
               (100 . "AcDbEntity")
               (410 . "Model")
               (62 . 0)
               (100 . "AcDbHatch")
               (10 0.0 0.0 0.0)
               (210 0.0 0.0 1.0)
               (2 . "SOLID")
               (70 . 1)
               (71 . 0)
               (91 . 1)
               (92 . 1)
               (93 . 1)
               (72 . 2)
               (10 0.0 0.0 0.0)
               (40 . 0.5)
               (50 . 0.0)
               (51 . 6.28319)
               (73 . 1)
               (97 . 0)
               (75 . 0)
               (76 . 1)
               (98 . 1)
               (10 0.0 0.0 0.0)
               (451 . 0)
               (460 . 0.0)
               (461 . 0.0)
               (452 . 1)
               (462 . 1.0)
               (453 . 2)
               (463 . 0.0)
               (463 . 1.0)
               (470 . "LINEAR")
              )
              ((0 . "ENDBLK"))
             )
    ) ;_  progn
   ) ;_  if
   (setq s (mapcar '(lambda (x)
                     (if x
                      x
                      1
                     ) ;_  if
                    ) ;_  lambda
                   (list (getreal "\nВведите масштаб по Х [1]:  ")
                         (getreal "\nВведите масштаб по Y [1]:  ")
                   ) ;_  list
           ) ;_  mapcar
   ) ;_  setq
   (setq l (GET_xl f))
   (foreach x (mapcar 'cdr l)
    (if x
     (entmakex
      (append
       (list '(0 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(410 . "Model")
             '(100 . "AcDbPolyline")
             (cons 90 (length x))
       ) ;_  list
       (mapcar
        '(lambda (a)
          (setq a (list 10 (* (car s) (car a)) (* (cadr s) (cadr a))))
          (entmakex (list '(0 . "INSERT") '(2 . "Отметка графика") a))
          a
         ) ;_  lambda
        x
       ) ;_  mapcar
      ) ;_  append
     ) ;_  entmakex
    ) ;_  if
   ) ;_  foreach
   (princ)
  ) ;_  progn
 ) ;_  if
) ;_  defun
Елпанов Евгений вне форума  
 
Автор темы   Непрочитано 17.07.2008, 12:41
#50
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Елпанов Евгений, Я по прежнему не могу запустить. Может я не верной командой пытаюсь?
Цитата:
Command: (GET_xl)
; error: too few arguments
__________________
Блог
Red Nova вне форума  
 
Непрочитано 17.07.2008, 12:44
#51
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Red Nova Посмотреть сообщение
Елпанов Евгений, Я по прежнему не могу запустить. Может я не верной командой пытаюсь?
действительно, не верно запускаете...
Запускайте, через командную строку автокада, командой "test" без кавычек.
Елпанов Евгений вне форума  
 
Непрочитано 17.07.2008, 12:48
#52
Rus2007


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


Команда для запуска test.
Rus2007 вне форума  
 
Непрочитано 17.07.2008, 12:51
#53
Rus2007


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


Елпанов Евгений большое спасибо! Все работает.
Rus2007 вне форума  
 
Автор темы   Непрочитано 17.07.2008, 14:04
#54
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Елпанов Евгений,
Спасибо, заработало. А можно добавить версию без запроса масштабов? Чтобы чертила без лишних вопросов.
И еще, может назвать команду как-то, ну типа graph-xls?
__________________
Блог
Red Nova вне форума  
 
Непрочитано 17.07.2008, 14:19
#55
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Red Nova Посмотреть сообщение
Елпанов Евгений,
Спасибо, заработало. А можно добавить версию без запроса масштабов? Чтобы чертила без лишних вопросов.
И еще, может назвать команду как-то, ну типа graph-xls?
собрал, здесь две программы
gx - рисует графики без масштаба
gxm - рисует графики с масштабом
Код:
[Выделить все]
(defun GET_xl (tbl / ADOCONNECT ADORECORDSET LST)
              ;|
     GET_XL.LSP
     created 21-04-2006
     last edit 19-02-2007
     Created by Elpanov Evgeny
     
     842@list.ru
     elpanov@gmail.com

Data reading from Microsoft Excel not using Excel.
This code, can read diverse data from all tables.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls")

 USAGE:
 (GET_xl tbl)

 RETURN VFALUES
 The list of all pages in a file with all data
|;
 (defun rec-rem-dupl (lst)
  (if lst
   (cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
  ) ;_  if
 ) ;_  defun
 (setq ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
       ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
 ) ;_  setq
 (if
  (not (vl-catch-all-error-p
        (vl-catch-all-apply
         (function vlax-invoke-method)
         (list ADOConnect
               "Open"
               (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
                       tbl
                       ";Extended Properties=;Excel 8.0;HDR=No"
               ) ;_  strcat
               "admin"
               ""
               nil
         ) ;_  list
        ) ;_  vl-catch-all-apply
       ) ;_  vl-catch-all-error-p
  ) ;_  not
  (progn (setq
          lst (mapcar
               (function (lambda (l / i c)
                          (vlax-invoke-method
                           ADORecordset
                           "Open"
                           (strcat "SELECT * FROM [" l "]")
                           ADOConnect
                           1
                           3
                           nil
                          ) ;_  vlax-invoke-method
                          (setq i
                                (length
                                 (car (vlax-safearray->list
                                       (vlax-variant-value
                                        (vlax-invoke-method ADORecordset "GetRows" 65535)
                                       ) ;_  vlax-variant-value
                                      ) ;_  vlax-safearray->list
                                 ) ;_  car
                                ) ;_  length
                          ) ;_  setq
                          (vlax-invoke-method ADORecordset "Close")
                          (while (not (zerop i))
                           (vlax-invoke-method
                            ADORecordset
                            "Open"
                            (strcat "SELECT * FROM ["
                                    l
                                    "a"
                                    (itoa i)
                                    ":IV"
                                    (itoa i)
                                    "]"
                            ) ;_  strcat
                            ADOConnect
                            1
                            3
                            nil
                           ) ;_  vlax-invoke-method
                           (setq c (cons
                                    (car
                                     (apply
                                      (function mapcar)
                                      (cons
                                       'list
                                       (mapcar
                                        (function
                                         (lambda (a)
                                          (mapcar
                                           (function (lambda (b) (vlax-variant-value b))
                                           ) ;_  function
                                           a
                                          ) ;_  mapcar
                                         ) ;_  lambda
                                        ) ;_  function
                                        (vlax-safearray->list
                                         (vlax-variant-value
                                          (vlax-invoke-method
                                           ADORecordset
                                           "GetRows"
                                           65535
                                          ) ;_  vlax-invoke-method
                                         ) ;_  vlax-variant-value
                                        ) ;_  vlax-safearray->list
                                       ) ;_  mapcar
                                      ) ;_  cons
                                     ) ;_  apply
                                    ) ;_  car
                                    c
                                   ) ;_  cons
                                 i (1- i)
                           ) ;_  setq
                           (vlax-invoke-method ADORecordset "Close")
                          ) ;_  while
                          (if (equal c '((nil) (nil)))
                           (list l)
                           (cons l c)
                          ) ;_  if
                         ) ;_  lambda
               ) ;_  function
               (mapcar
                (function (lambda (x)
                           (if (= (substr x 1 1) "'")
                            (substr x 2 (- (strlen x) 2))
                            x
                           ) ;_  if
                          ) ;_  lambda
                ) ;_  function
                (rec-rem-dupl
                 (caddr
                  (mapcar
                   (function
                    (lambda (a) (mapcar (function vlax-variant-value) a))
                   ) ;_  function
                   (vlax-safearray->list
                    (vlax-variant-value
                     (vlax-invoke-method
                      (vlax-invoke-method ADOConnect "OpenSchema" 4)
                      "GetRows"
                      65535
                     ) ;_  vlax-invoke-method
                    ) ;_  vlax-variant-value
                   ) ;_  vlax-safearray->list
                  ) ;_  apply
                 ) ;_  caddr
                ) ;_  rec-rem-dupl
               ) ;_  mapcar
              ) ;_  mapcar
         ) ;_  setq
         (vlax-invoke-method ADOConnect "Close")
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         lst
  ) ;_  progn
  (progn
   (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close"))
   (vlax-release-object ADORecordset)
   (vlax-release-object ADOConnect)
   (setq ADORecordset nil
         ADOConnect nil
   ) ;_  setq
   nil
  ) ;_  progn
 ) ;_  if
) ;_  defun

(defun c:gx (/ A B F L)
 ;;пример для экселя...
 ;; c автоматическим созданием блоков отметок.
 (vl-load-com)
 (if (setq f (getfiled "Укажите файл с точками графика" "" "xls" 0))
  (progn
   (if (null (tblobjname "BLOCK" "Отметка графика"))
    (mapcar 'entmakex
            '(((0 . "BLOCK")
               (100 . "AcDbEntity")
               (67 . 0)
               (8 . "0")
               (100 . "AcDbBlockBegin")
               (70 . 0)
               (10 0.0 0.0 0.0)
               (2 . "Отметка графика")
               (1 . "")
              )
              ((0 . "HATCH")
               (100 . "AcDbEntity")
               (410 . "Model")
               (62 . 0)
               (100 . "AcDbHatch")
               (10 0.0 0.0 0.0)
               (210 0.0 0.0 1.0)
               (2 . "SOLID")
               (70 . 1)
               (71 . 0)
               (91 . 1)
               (92 . 1)
               (93 . 1)
               (72 . 2)
               (10 0.0 0.0 0.0)
               (40 . 0.5)
               (50 . 0.0)
               (51 . 6.28319)
               (73 . 1)
               (97 . 0)
               (75 . 0)
               (76 . 1)
               (98 . 1)
               (10 0.0 0.0 0.0)
               (451 . 0)
               (460 . 0.0)
               (461 . 0.0)
               (452 . 1)
               (462 . 1.0)
               (453 . 2)
               (463 . 0.0)
               (463 . 1.0)
               (470 . "LINEAR")
              )
              ((0 . "ENDBLK"))
             )
    ) ;_  progn
   ) ;_  if
   (setq l (GET_xl f))
   (foreach x (mapcar 'cdr l)
    (if x
     (entmakex
      (append
       (list '(0 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(410 . "Model")
             '(100 . "AcDbPolyline")
             (cons 90 (length x))
       ) ;_  list
       (mapcar
        '(lambda (a)
          (setq a (list 10 (car a) (cadr a)))
          (entmakex (list '(0 . "INSERT") '(2 . "Отметка графика") a))
          a
         ) ;_  lambda
        x
       ) ;_  mapcar
      ) ;_  append
     ) ;_  entmakex
    ) ;_  if
   ) ;_  foreach
   (princ)
  ) ;_  progn
 ) ;_  if
)
(defun c:gxm (/ A B F L)
 ;;пример для экселя...
 ;; c запросом масштаба и автоматическим созданием блоков отметок.
 (vl-load-com)
 (if (setq f (getfiled "Укажите файл с точками графика" "" "xls" 0))
  (progn
   (if (null (tblobjname "BLOCK" "Отметка графика"))
    (mapcar 'entmakex
            '(((0 . "BLOCK")
               (100 . "AcDbEntity")
               (67 . 0)
               (8 . "0")
               (100 . "AcDbBlockBegin")
               (70 . 0)
               (10 0.0 0.0 0.0)
               (2 . "Отметка графика")
               (1 . "")
              )
              ((0 . "HATCH")
               (100 . "AcDbEntity")
               (410 . "Model")
               (62 . 0)
               (100 . "AcDbHatch")
               (10 0.0 0.0 0.0)
               (210 0.0 0.0 1.0)
               (2 . "SOLID")
               (70 . 1)
               (71 . 0)
               (91 . 1)
               (92 . 1)
               (93 . 1)
               (72 . 2)
               (10 0.0 0.0 0.0)
               (40 . 0.5)
               (50 . 0.0)
               (51 . 6.28319)
               (73 . 1)
               (97 . 0)
               (75 . 0)
               (76 . 1)
               (98 . 1)
               (10 0.0 0.0 0.0)
               (451 . 0)
               (460 . 0.0)
               (461 . 0.0)
               (452 . 1)
               (462 . 1.0)
               (453 . 2)
               (463 . 0.0)
               (463 . 1.0)
               (470 . "LINEAR")
              )
              ((0 . "ENDBLK"))
             )
    ) ;_  progn
   ) ;_  if
   (setq s (mapcar '(lambda (x)
                     (if x
                      x
                      1
                     ) ;_  if
                    ) ;_  lambda
                   (list (getreal "\nВведите масштаб по Х [1]:  ")
                         (getreal "\nВведите масштаб по Y [1]:  ")
                   ) ;_  list
           ) ;_  mapcar
   ) ;_  setq
   (setq l (GET_xl f))
   (foreach x (mapcar 'cdr l)
    (if x
     (entmakex
      (append
       (list '(0 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(410 . "Model")
             '(100 . "AcDbPolyline")
             (cons 90 (length x))
       ) ;_  list
       (mapcar
        '(lambda (a)
          (setq a (list 10 (* (car s) (car a)) (* (cadr s) (cadr a))))
          (entmakex (list '(0 . "INSERT") '(2 . "Отметка графика") a))
          a
         ) ;_  lambda
        x
       ) ;_  mapcar
      ) ;_  append
     ) ;_  entmakex
    ) ;_  if
   ) ;_  foreach
   (princ)
  ) ;_  progn
 ) ;_  if
)
Елпанов Евгений вне форума  
 
Автор темы   Непрочитано 17.07.2008, 15:34
#56
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Большое спасибо за помощь.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 17.07.2008, 16:21
#57
Rus2007


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


А как отключить автоматическое создание блоков отметок, а создать шкалу по Х, Y автоматом?
Rus2007 вне форума  
 
Непрочитано 17.07.2008, 16:26
#58
VVA

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


Цитата:
А как отключить автоматическое создание блоков отметок
Закоментировать фрагмент лиспа
Цитата:
, а создать шкалу по Х, Y автоматом?
Дописать фрагмент кода на лиспе
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 17.07.2008, 16:32
#59
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Rus2007 Посмотреть сообщение
А как отключить автоматическое создание блоков отметок, а создать шкалу по Х, Y автоматом?
Алгоритм обычный, все как везде, сначала надо бежать в магазин за пивом, т.е. не пивом, а книгой Николая Полещука. Хотя, пиво в любом случае не будет лишним!
Потом читаешь до появления чувства просветления.
Если не хватает пива или книжки, бежишь еще раз.
Потом начинаешь ковырять программу, регулярно напрягая весь форум, своими вопросами...
Елпанов Евгений вне форума  
 
Непрочитано 17.07.2008, 16:33
#60
Rus2007


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


Большое спасибо буду бежать за пивом...
Rus2007 вне форума  
 
Непрочитано 07.08.2008, 11:39
#61
Alex II


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


Цитата:
Сообщение от Елпанов Евгений Посмотреть сообщение
нет проблем - добавил свою старенькую функцию чтения из экселя...
Из плюсов - читает экселевские файлы, даже если эксель не установлен.
Если в экселе есть несколько листов, точнее есть данные в нескольких листах, то будет создано несколько графиков, по одному на каждый лист.
Из ограничений - я не парился с адресацией данных в экселе, т.е для отрисовки берутся два первых попавшихся столбца с данными и предполагается, что в них числа...
Pochemuto iz odnogo faila stroit normal'no, a iz drugih pishet: error: bad DXF group: (10 nil nil) i rasstavljajet tol'ko bloki, polylinijej ne sojedinjajet. Ne znajete v chjom delo?
Alex II вне форума  
 
Непрочитано 20.01.2009, 17:15
#62
Nazhul


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


Помогите плиз...
Похожая проблема но (!) имеется файл в котором ряд столбцов (фиксированиое количество 21). Первый столбец - значения по X,
Последующие 20 слобцов - 5 групп по 4 столбца.
X Y1 Y2 Y3 ... Y20
необходимо построить 5 графиков с четымя полилиниями на каждом графике. Координаты каждого графика задаются отдельно.
первый график Y1=f(x), Y2=f(x), Y3=f(x), Y4=f(x)
второй Y5=f(x), Y6=f(x), Y7=f(x), Y8=f(x)
и т. п.
X - общий для всех
Y - по 4 линии на каждый график.
Каждое значение Y подписывается рядом (не имеет значение где хотя лутше если не в точке графика и с задаваемой величиной высоты текста)
Без (!) подключения екселя потому как график передают с другой фирмы где он есть, а на работе у меня нет...
Переганять на 20 графиков неудобно.

Последний раз редактировалось Nazhul, 20.01.2009 в 18:54.
Nazhul вне форума  
 
Непрочитано 20.01.2009, 18:19
#63
-mavlin-


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


Вот есть такая прога http://dwg.ru/dnl/4177
Правда, подписи значений не ставит
-mavlin- вне форума  
 
Непрочитано 20.01.2009, 18:50
#64
Nazhul


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


Смотрел, не получается...
Возможно не понял схему работы...
Опишите какой результат должен дыть после каждой команды или шага.останавливаюсь на "откройте нужный файл в ексель" - а Екселя то нету....
Заранее спасибо...
Подписи данных обязательны.
Nazhul вне форума  
 
Непрочитано 20.01.2009, 20:46
#65
-mavlin-


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


Без экселя програмка работать не будет. И подписи данных она не ставит. Текстовый файл довольно легко можно перегнать в эксель.

Или, как вариант, можно построить графики в экселе (либо в чем-то еще) и вставить их в автокад как OLE-объекты.

Последний раз редактировалось -mavlin-, 20.01.2009 в 20:52.
-mavlin- вне форума  
 
Непрочитано 21.01.2009, 09:36
#66
Nazhul


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


В темке уже была программа которая работает без екселя.
Работает хорошо. Но только по двум слобцам. И не подписывает данные.
Необходимо подкоректировать но как, не знаю.
Nazhul вне форума  
 
Непрочитано 21.01.2009, 20:23
#67
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,649


Цитата:
Сообщение от Nazhul Посмотреть сообщение
Помогите плиз...
Похожая проблема но (!) имеется файл в котором ряд столбцов (фиксированиое количество 21). Первый столбец - значения по X,
Последующие 20 слобцов - 5 групп по 4 столбца.
X Y1 Y2 Y3 ... Y20
необходимо построить 5 графиков с четымя полилиниями на каждом графике. Координаты каждого графика задаются отдельно.
первый график Y1=f(x), Y2=f(x), Y3=f(x), Y4=f(x)
второй Y5=f(x), Y6=f(x), Y7=f(x), Y8=f(x)
и т. п.
X - общий для всех
Y - по 4 линии на каждый график.
Каждое значение Y подписывается рядом (не имеет значение где хотя лутше если не в точке графика и с задаваемой величиной высоты текста)
Без (!) подключения екселя потому как график передают с другой фирмы где он есть, а на работе у меня нет...
Переганять на 20 графиков неудобно.
Вот программка на VBA, теоретически должна делать то, что вы хотите. (Модуль BrowseForFolder у кого-то передрал). При запуске появляется форма; в верхнем текстбоксе отображается текущая папка (в которой должен находиться файл с координатами графиков), комбобокс ниже - со списком всех текстовых файлов из этой папки. Директория при 1-м запуске - либо та же, где лежит файл dvb, либо корень диска C. При последующих запусках теоретически должны отображаться те папка и файл, которые были выбраны при выходе из программы. Соответствующая кнопка позволяет директорию поменять. При выборе файла в комбобоксе информация с него считывается в массив (21 столбец, строк - произвольное кол-во). Разделители строк - vbcrlf ("enter"), столбцов - те что вбиты в соответствуещее текстовое поле. Кнопка "Создать тестовый файл" создает в текущей директории файл "примера", - произвольное кол-во строк, значения Y из всех столбцов, кроме 1-го (который "x")- случайные числа; разделитель столбцов - из соотв. текстового поля.
Кнопка голубого цвета должна вставлять графики в пр-во модели чертежа (для каждого из 5 графиков нач. точка задается пользователем)
В каждую вершину полилинии вставляется текст с координатой Y, высота текста - из соотв. поля на форме.
При изменении имени файла в комбобоксе можно просмотреть все загрузившиеся координаты в листбоксе (дабы его лицезреть, надо нажать кнопку "\/"). Если в файле, к примеру, меньше 21 столбца, то недостающие значения заменяются 0)
Миниатюры
Нажмите на изображение для увеличения
Название: Безымянный.jpg
Просмотров: 1585
Размер:	50.7 Кб
ID:	15008  Нажмите на изображение для увеличения
Название: ____.JPG
Просмотров: 1203
Размер:	90.5 Кб
ID:	15009  
Вложения
Тип файла: rar Grafiki.rar (54.9 Кб, 775 просмотров)
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!

Последний раз редактировалось AlexV, 21.01.2009 в 20:40.
AlexV вне форума  
 
Непрочитано 21.01.2009, 20:31
#68
maximas

проектирование. автоматика
 
Регистрация: 18.10.2007
Литва
Сообщений: 104


может чуть не по теме, но касательно.
Получили как-то чертеж из морского порта, так там в екселе чертеж корабля . т. е. ячейки квадратные, и как пиксели. оооочень удивило, кто нибудь встречал похожее ?
__________________
проектирование автоматика
maximas вне форума  
 
Непрочитано 21.01.2009, 23:06
#69
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,741


Даже на форуме где-то выкладывалось, по-моему...
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 22.01.2009, 12:18
#70
Nazhul


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


Суперррр...
Только почему-то остання строка все нули и график замыкается на начало координат...
И еще такое дело.... А возможно задавать максимальное значение высоты графика отнсительно которого будут маштабироватся графики (но не их значания). Напр. Не выше 20 ед.
и как сделать разделитель по умолчанию Tab?

Последний раз редактировалось Nazhul, 22.01.2009 в 13:46.
Nazhul вне форума  
 
Непрочитано 22.01.2009, 13:47
#71
Nazhul


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


Все спасиб ничего менять не нужно сам подправил под свои нужды. Там кнопочки поменял и т.п...
Риспект огромный за помощь.
Осталось только сделать чтобы несколько пробелов считало как 1....

Последний раз редактировалось Nazhul, 22.01.2009 в 14:11.
Nazhul вне форума  
 
Непрочитано 22.01.2009, 21:23
#72
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,649


Цитата:
Сообщение от Nazhul Посмотреть сообщение
Все спасиб ничего менять не нужно сам подправил под свои нужды. Там кнопочки поменял и т.п...
Риспект огромный за помощь.
Осталось только сделать чтобы несколько пробелов считало как 1....
Несколько пробелов тоже можно задать в текстбоксе. Но правда, разделитель должен быть одинаковый (т.е. если 2
пробела, - то везде 2, если 3 -то 3 и т.д.) Если кол-во пробелов может быть разным, то надо добавить функцию обработки разделителя (я думаю, это не сложно).
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!

Последний раз редактировалось AlexV, 22.01.2009 в 21:30.
AlexV вне форума  
 
Непрочитано 17.04.2009, 14:54
#73
Сергей Дубина


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


Предлагаю сделать следующее:
Вставить данные в эксэль (если они ещё не там), разбить текст по столбцам (если не ошибаюсь разделитель - запятая) в итоге получите несколько столбцов.
В соседнем столбике вбейте формулу ="_point "&A1&","&B1&","&C1
(пример для трёх координат x,y,z) и протяните по всем строчкам. Далее копируется полученное в бувер обмена и вставляется непосредственно в коммандную строку. И никакой высшей математики. Имея навыки работы с акадом эта схема легко адаптируется под другие примитивы. Удачи.
Сергей Дубина вне форума  
 
Непрочитано 17.04.2009, 23:09
#74
-mavlin-


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


Цитата:
Сообщение от Сергей Дубина Посмотреть сообщение
Предлагаю сделать следующее:
Вставить данные в эксэль (если они ещё не там), разбить текст по столбцам (если не ошибаюсь разделитель - запятая) в итоге получите несколько столбцов.
В соседнем столбике вбейте формулу ="_point "&A1&","&B1&","&C1
(пример для трёх координат x,y,z) и протяните по всем строчкам. Далее копируется полученное в бувер обмена и вставляется непосредственно в коммандную строку. И никакой высшей математики. Имея навыки работы с акадом эта схема легко адаптируется под другие примитивы. Удачи.
Пять баллов!!! Молодец!
И не надо никакого лиспа или ВБА
-mavlin- вне форума  
 
Непрочитано 22.04.2009, 09:27
#75
Nazhul


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


А как же с подписями данных???
То что уже доделано проекрасно работает и подписывает координаты эпюр.
Но как вариант просто нарисовать ломаную можно использовать и такой подход канечно...
Nazhul вне форума  
 
Непрочитано 27.03.2011, 20:51
#76
Fynjy87


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


Здравствуйте!

Помогите, пожалуйста, решить проблему. Я слегка переделал под свои нужды программу Елпанова Евгения из сообщения #55.
Но оказалось, что она не работает с файлами, которые создает MathCAD при экспорте данных в Excel. Не пойму почему, вроде, формат такой же.
Вот образец файла экселя, который создан маткадом:
http://narod.ru/disk/8570182001/Qn-Hn.rar.html


Проблема отпала, т.к. нашелся способ наладить нормальный вывод из маткада в эксель. Спасибо, если пытались решить эту проблему.


Код:
[Выделить все]
 (defun GET_xl (tbl / ADOCONNECT ADORECORDSET LST)
              ;|
     GET_XL.LSP
     created 21-04-2006
     last edit 19-02-2007
     Created by Elpanov Evgeny
     
     842@list.ru
     elpanov@gmail.com

Data reading from Microsoft Excel not using Excel.
This code, can read diverse data from all tables.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls")

 USAGE:
 (GET_xl tbl)

 RETURN VFALUES
 The list of all pages in a file with all data
|;
 (defun rec-rem-dupl (lst)
  (if lst
   (cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
  ) ;_  if
 ) ;_  defun
 (setq ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
       ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
 ) ;_  setq
 (if
  (not (vl-catch-all-error-p
        (vl-catch-all-apply
         (function vlax-invoke-method)
         (list ADOConnect
               "Open"
               (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
                       tbl
                       ";Extended Properties=;Excel 8.0;HDR=No"
               ) ;_  strcat
               "admin"
               ""
               nil
         ) ;_  list
        ) ;_  vl-catch-all-apply
       ) ;_  vl-catch-all-error-p
  ) ;_  not
  (progn (setq
          lst (mapcar
               (function (lambda (l / i c)
                          (vlax-invoke-method
                           ADORecordset
                           "Open"
                           (strcat "SELECT * FROM [" l "]")
                           ADOConnect
                           1
                           3
                           nil
                          ) ;_  vlax-invoke-method
                          (setq i
                                (length
                                 (car (vlax-safearray->list
                                       (vlax-variant-value
                                        (vlax-invoke-method ADORecordset "GetRows" 65535)
                                       ) ;_  vlax-variant-value
                                      ) ;_  vlax-safearray->list
                                 ) ;_  car
                                ) ;_  length
                          ) ;_  setq
                          (vlax-invoke-method ADORecordset "Close")
                          (while (not (zerop i))
                           (vlax-invoke-method
                            ADORecordset
                            "Open"
                            (strcat "SELECT * FROM ["
                                    l
                                    "a"
                                    (itoa i)
                                    ":IV"
                                    (itoa i)
                                    "]"
                            ) ;_  strcat
                            ADOConnect
                            1
                            3
                            nil
                           ) ;_  vlax-invoke-method
                           (setq c (cons
                                    (car
                                     (apply
                                      (function mapcar)
                                      (cons
                                       'list
                                       (mapcar
                                        (function
                                         (lambda (a)
                                          (mapcar
                                           (function (lambda (b) (vlax-variant-value b))
                                           ) ;_  function
                                           a
                                          ) ;_  mapcar
                                         ) ;_  lambda
                                        ) ;_  function
                                        (vlax-safearray->list
                                         (vlax-variant-value
                                          (vlax-invoke-method
                                           ADORecordset
                                           "GetRows"
                                           65535
                                          ) ;_  vlax-invoke-method
                                         ) ;_  vlax-variant-value
                                        ) ;_  vlax-safearray->list
                                       ) ;_  mapcar
                                      ) ;_  cons
                                     ) ;_  apply
                                    ) ;_  car
                                    c
                                   ) ;_  cons
                                 i (1- i)
                           ) ;_  setq
                           (vlax-invoke-method ADORecordset "Close")
                          ) ;_  while
                          (if (equal c '((nil) (nil)))
                           (list l)
                           (cons l c)
                          ) ;_  if
                         ) ;_  lambda
               ) ;_  function
               (mapcar
                (function (lambda (x)
                           (if (= (substr x 1 1) "'")
                            (substr x 2 (- (strlen x) 2))
                            x
                           ) ;_  if
                          ) ;_  lambda
                ) ;_  function
                (rec-rem-dupl
                 (caddr
                  (mapcar
                   (function
                    (lambda (a) (mapcar (function vlax-variant-value) a))
                   ) ;_  function
                   (vlax-safearray->list
                    (vlax-variant-value
                     (vlax-invoke-method
                      (vlax-invoke-method ADOConnect "OpenSchema" 4)
                      "GetRows"
                      65535
                     ) ;_  vlax-invoke-method
                    ) ;_  vlax-variant-value
                   ) ;_  vlax-safearray->list
                  ) ;_  apply
                 ) ;_  caddr
                ) ;_  rec-rem-dupl
               ) ;_  mapcar
              ) ;_  mapcar
         ) ;_  setq
         (vlax-invoke-method ADOConnect "Close")
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         lst
  ) ;_  progn
  (progn
   (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close"))
   (vlax-release-object ADORecordset)
   (vlax-release-object ADOConnect)
   (setq ADORecordset nil
         ADOConnect nil
   ) ;_  setq
   nil
  ) ;_  progn
 ) ;_  if
) ;_  defun

(defun c:gx (/ A B F L)
 ;;пример для экселя...
 (vl-load-com)
 (if (setq f (getfiled "Укажите файл с точками графика" "" "xls" 0))
  (progn
   (setq l (GET_xl f))
   (foreach x (mapcar 'cdr l)
    (if x
     (entmakex
      (append
       (list '(0 . "SPLINE")
             '(100 . "AcDbEntity")
             '(410 . "Model")
         '(8 . "0")
             '(100 . "AcDbSpline")
         '(210 0.0 0.0 1.0)
         '(71 . 3)
       ) ;_  list
       (mapcar
        '(lambda (a)
          (setq a (list 11 (car a) (cadr a)))
          a
         ) ;_  lambda
        x
       ) ;_  mapcar
      ) ;_  append
     ) ;_  entmakex
    ) ;_  if
   ) ;_  foreach
   (princ)
  ) ;_  progn
 ) ;_  if
)

Последний раз редактировалось Fynjy87, 28.03.2011 в 14:05.
Fynjy87 вне форума  
 
Непрочитано 18.11.2011, 17:46
#77
Mikhail

инженер-технолог (ГИП)
 
Регистрация: 11.09.2003
Санкт-Петербург
Сообщений: 1,134


Цитата:
Сообщение от VVA Посмотреть сообщение
Как-то была задача экспортировать точки и их описание из Excell в Автокад. На основе кода, выложенного здесь и опубликованного здесь. К нему прикрутил функцию Алексея graph-by-file-with-poin. Получилось такие команды:
Xl2PT - импорт точек из Excel в Автокад Столбец A - X; B - Y; C - Z; D - описание точки Высота текста - переменная TEXTSIZE
Xl2PL - построение LW полилинии по координатам столбцов A (X) и B (Y)

*** Добавлено
Грузить vlx файл
Доброго дня.
что то поискал и нашел кучу прграмм, но как то не получается у точек проставить описание их.
Подскажите, что не так могу делать?
__________________
Большая беда науки в том, что при восхитительной теории можно получить отвратительные результаты.
Mikhail вне форума  
 
Непрочитано 18.11.2011, 18:16
#78
VVA

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


Цитата:
Сообщение от Mikhail Посмотреть сообщение
Доброго дня.
что то поискал и нашел кучу прграмм, но как то не получается у точек проставить описание их.
Подскажите, что не так могу делать?
Сложно догадаться по 3 строчкам, что делаешь не так. Из Минска СПБ не видно
Посмотри эту программу: Импорт координат из текстового файла txt (sdr csv) в AutoCAD
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.11.2011, 22:06
#79
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


Цитата:
Сообщение от VVA Посмотреть сообщение
Из Минска СПБ не видно
Offtop: Вот он
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 21.11.2011, 09:28
#80
Mikhail

инженер-технолог (ГИП)
 
Регистрация: 11.09.2003
Санкт-Петербург
Сообщений: 1,134


Цитата:
Сообщение от VVA Посмотреть сообщение
Сложно догадаться по 3 строчкам, что делаешь не так. Из Минска СПБ не видно
Спасибо за отклик)
Загружаю GetPointFormExcel.VLX
выбираю файл excel. Точки программа строит, а описание точки из столбца D не ставит.
p.s. а за ссылку на программу спасибо. она в принципе делает, что надо. просто приходится перекидывать из экселя в тхт файл данные.
__________________
Большая беда науки в том, что при восхитительной теории можно получить отвратительные результаты.

Последний раз редактировалось Mikhail, 21.11.2011 в 09:49.
Mikhail вне форума  
 
Непрочитано 21.11.2011, 13:03
#81
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от Mikhail Посмотреть сообщение
выбираю файл excel. Точки программа строит, а описание точки из столбца D не ставит.
Покажи файл Эксель и чертеж
Олег (jr.) вне форума  
 
Непрочитано 21.11.2011, 13:30
#82
Mikhail

инженер-технолог (ГИП)
 
Регистрация: 11.09.2003
Санкт-Петербург
Сообщений: 1,134


вот файл.
xls почему то не прикреплялся, его засунул в архив.
Вложения
Тип файла: dwg
DWG 2004
4.dwg (54.5 Кб, 3181 просмотров)
Тип файла: rar 4.rar (1.5 Кб, 83 просмотров)
__________________
Большая беда науки в том, что при восхитительной теории можно получить отвратительные результаты.
Mikhail вне форума  
 
Непрочитано 21.11.2011, 14:04
#83
Сергей Дубина


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


так?
Вложения
Тип файла: zip пример.zip (26.5 Кб, 156 просмотров)
__________________
КазнитьØнельзяØпомиловать:eek:
Сергей Дубина вне форума  
 
Непрочитано 21.11.2011, 14:23
#84
VVA

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


Цитата:
Сообщение от Mikhail Посмотреть сообщение
а за ссылку на программу спасибо. она в принципе делает, что надо. просто приходится перекидывать из экселя в тхт файл данные
Сохрани файл excel'a как csv
+ Обновил #28
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.11.2011, 14:31
#85
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от Mikhail Посмотреть сообщение
вот файл.
xls почему то не прикреплялся, его засунул в архив.
Вернусь позже
Олег (jr.) вне форума  
 
Непрочитано 21.11.2011, 14:44
#86
Mikhail

инженер-технолог (ГИП)
 
Регистрация: 11.09.2003
Санкт-Петербург
Сообщений: 1,134


Цитата:
Сообщение от VVA Посмотреть сообщение
Сохрани файл excel'a как csv
+ Обновил #28
спасибо. все работает.
Цитата:
Сообщение от Сергей Дубина
....
А что с эксель файлом? мне из экселя в автокад надо по простым табличкам, как VVA подправил.
__________________
Большая беда науки в том, что при восхитительной теории можно получить отвратительные результаты.
Mikhail вне форума  
 
Непрочитано 21.11.2011, 17:02
#87
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Закомментировал дубликат вызова
Выбирай 4 столбца не не 3

Код:
[Выделить все]
;; local defun
;; Fatty T.O.H. (c) 2011 * all rights released
(defun RefSelection (/ *error* addr c2 c2 Excelapp Sel Sht r1 r2 Rng vl Wbk)
  (vl-load-com)
  (defun *error*  (msg)
    (if
      (vl-position
	msg
	'("console break"
	  "Function cancelled"
	  "quit / exit abort"
	  )
	)
       (princ "Error!")
       (princ msg)
       )
            (vl-catch-all-apply
	'vlax-invoke-method
	(list Wbk "Close")
      )

	(vl-catch-all-apply
	  'vlax-invoke-method
	  (list ExcelApp "Quit")
	)

  (mapcar
    (function (lambda (x)(vl-catch-all-apply(function (lambda()
		(if (not (vlax-object-released-p x))
		  (progn
		  (vlax-release-object x)
		  (setq x nil))
		)
	      )
    )
			   )
		)
	      )
    (list Sel Sht Wbk ExcelApp)
  )  
  (gc)
  (gc) 
    (princ)
    )
  

(setq ExcelApp (vl-catch-all-apply
	       (function (lambda ()(vlax-get-or-create-object "Excel.Application")))))

(if (vl-catch-all-error-p
      (setq Wbk
	     (vl-catch-all-apply
	       (function (lambda ()
			   (vlax-get-property ExcelApp "ActiveWorkBook"))))))
  (progn
    (alert "Excel WorkBook Must Be Open Before!")
    (exit)
    (*error* nil)
    (princ)
    )
  )
(setq Sht
       (vl-catch-all-apply
	 (function (lambda ()
		     (vlax-get-property ExcelApp "ActiveSheet")))))

(vlax-put-property ExcelApp 'visible :vlax-true)

(vlax-put-property ExcelApp 'ScreenUpdating :vlax-true)

(vlax-put-property ExcelApp 'DisplayAlerts :vlax-false)

(if (not (vl-catch-all-error-p
	   (setq Rng
		  (vl-catch-all-apply
		    (function (lambda ()
				(vlax-variant-value
				  (vlax-invoke-method
				    (vlax-get-property Wbk 'Application)
				    'Inputbox
				    "Выбрать диапазон данных,\n	нажать OK :"
				    "Данные графика"
				    nil
				    nil
				    nil
				    nil
				    nil
				    8))))))))
  (progn
    (vlax-put-property ExcelApp 'DisplayAlerts :vlax-true)

    (setq r1 (vlax-get-property Rng 'row))
    (setq c1 (vlax-get-property Rng 'column))
    (setq r2 (vlax-get-property (vlax-get-property Rng 'rows) 'count))
    (setq c2 (vlax-get-property (vlax-get-property Rng 'columns) 'count))

    (setq addr (strcat (chr (+ 64 c1))
		       (itoa r1)
		       ":"
		       (chr (+ (ascii (chr (+ 64 c1))) (1- c2)))
		       (itoa (+ r1 (1- r2)))))

    (setq Rng (vlax-get-property sht 'Range addr))

    (vlax-invoke Rng 'Select)
    )
  )

(if Rng
  (progn
    (setq vl (mapcar (function (lambda (x)
				 (mapcar 'vlax-variant-value x)))
		     (vlax-safearray->list
		       (vlax-variant-value
			 (vlax-get-property Rng 'value2)))))
    (princ "\n")
	   (princ (vl-princ-to-string vl))
    (princ "\n")
	   )
    (progn
      (alert "Select Excel Range Before!")
      (exit)
      (*error* nil)
      (princ)
      )
    )

(*error* nil)
  vl
)
(defun C:PRR (/ point_data pt1 txt1 txthgt txup1 )
  
 (if (setq point_data (RefSelection))
   (progn

     (setq osm (getvar 'osmode))
     (command "_.undo" "be")
    ;; (setq point_data (RefSelection));;<--скопировал дважды за каким-то...
     (setq point_data
	    (mapcar (function (lambda (x)
				(list (reverse (cdr (reverse x))) (last x))))
		    point_data)
	   )
     (setq txthgt 0.25)
     (setvar 'pdsize txthgt)
     (setvar 'pdmode 34)


     (foreach item  point_data

       (setq pt1   (car item)

	     txt1  (last item)

	     txup1 (mapcar '+
			   pt1
			   (list 0 txthgt))

	     )

       (entmake
	 (list
	   (cons 0 "POINT")
	   (cons 100 "AcDbEntity")
	   (cons 100 "AcDbPoint")
	   (cons 10 pt1)
	   (cons 8 "0")
	   '(62 . 1)
	   )
	 )
       (entmake
	 (list
	   '(0 . "TEXT")
	   '(100 . "AcDbEntity")
	   '(67 . 0)
	   '(410 . "Model")
	   '(8 . "0")
	   '(62 . 121)
	   '(100 . "AcDbText")
	   (cons 10
		 (list (- (car txup1) (* txthgt 0.375) (cadr txup1)) 0.0))
	   (cons 11 txup1)
	   (cons 40 txthgt)
	   (cons 1 txt1)
	   '(50 . 0.0)
	   '(41 . 1.0)
	   '(51 . 0.0)
	   '(7 . "Standard")
	   '(71 . 0)
	   '(72 . 1)
	   (cons 210 (list 0.0 0.0 1.0))
	   '(73 . 0)))
       )
     )
   (command "_.undo" "e")
   )
(princ)
)
(princ "\n   >>>   В командной строке введите: PRR   <<<")
(princ)

Последний раз редактировалось Олег (jr.), 22.11.2011 в 22:49.
Олег (jr.) вне форума  
 
Непрочитано 22.11.2011, 12:07
#88
Mikhail

инженер-технолог (ГИП)
 
Регистрация: 11.09.2003
Санкт-Петербург
Сообщений: 1,134


Цитата:
Сообщение от Олег (jr.) Посмотреть сообщение
См. результат, что прислал то и получи
ну в принципи VVA подкорректировал лисп и все работает нормально. а твой что то выдает следующую крякозябру
Command: PRR

((23.0 324.0 23.0) (24.0 325.0 4234.0) (25.0 326.0 234.0) (26.0 327.0 234.0)
(27.0 328.0 3.0) (28.0 329.0 5.0) (29.0 330.0 45.0) (30.0 331.0 45.0) (31.0
332.0 0.0) (32.0 333.0 45.0) (33.0 334.0 343.0) (34.0 335.0 6.0) (35.0 336.0
45.0) (36.0 337.0 0.0))
nil_.undo Current settings: Auto = On, Control = All, Combine = Yes, Layer = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: be
Command: bad argument type: VLA-OBJECT #<%catch-all-apply-error%>
__________________
Большая беда науки в том, что при восхитительной теории можно получить отвратительные результаты.
Mikhail вне форума  
 
Непрочитано 22.11.2011, 22:50
#89
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


См/ исправления в посте #87
Олег (jr.) вне форума  
 
Непрочитано 23.11.2011, 09:55
#90
Mikhail

инженер-технолог (ГИП)
 
Регистрация: 11.09.2003
Санкт-Петербург
Сообщений: 1,134


Цитата:
Сообщение от Олег (jr.) Посмотреть сообщение
См/ исправления в посте #87
всё ок. спасибо.
__________________
Большая беда науки в том, что при восхитительной теории можно получить отвратительные результаты.
Mikhail вне форума  
 
Непрочитано 24.11.2011, 00:13
1 | #91
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813



Очень рад
Олег (jr.) вне форума  
 
Непрочитано 10.08.2012, 09:30
#92
bridgeconst

проектирование
 
Регистрация: 29.11.2007
Москва
Сообщений: 308


Обнаружил еще одну маленькую проблемку - при использовании xl2pt четвертом столбце в Exel'е (имя точки) в ячейке не должен быть "голая"цифра. В противном случае выдает ошибку bad dxf (1. ____).
Решается конечно просто добавлением буквенного префикса перед цифрой.
А в остальном прекрасная программа. Спасибо автору.
P.S. Я даже не представляю как бы я вручную 10 000 точек из GPS вводил...
__________________
Обмениваю незнание на время.
bridgeconst вне форума  
 
Непрочитано 10.08.2012, 10:26
#93
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от bridgeconst Посмотреть сообщение
Обнаружил еще одну маленькую проблемку - при использовании xl2pt четвертом столбце в Exel'е (имя точки) в ячейке не должен быть "голая"цифра. В противном случае выдает ошибку bad dxf (1. ____).
Спасибо за замечание, буду исправлять,
Удачи

~'o'~
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 18.05.2013, 17:29
#94
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Вернулся в тему.
Долгое время благополучно использовал лисп от Елпанов Евгений, но после перехода на 2013-й лисп перестал работать. Прошу помощи.
Код:
[Выделить все]
 (defun GET_xl (tbl / ADOCONNECT ADORECORDSET LST)
              ;|
     GET_XL.LSP
     created 21-04-2006
     last edit 19-02-2007
     Created by Elpanov Evgeny
     
     842@list.ru
     elpanov@gmail.com

Data reading from Microsoft Excel not using Excel.
This code, can read diverse data from all tables.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls")

 USAGE:
 (GET_xl tbl)

 RETURN VFALUES
 The list of all pages in a file with all data
|;
 (defun rec-rem-dupl (lst)
  (if lst
   (cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
  ) ;_  if
 ) ;_  defun
 (setq ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
       ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
 ) ;_  setq
 (if
  (not (vl-catch-all-error-p
        (vl-catch-all-apply
         (function vlax-invoke-method)
         (list ADOConnect
               "Open"
               (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
                       tbl
                       ";Extended Properties=;Excel 8.0;HDR=No"
               ) ;_  strcat
               "admin"
               ""
               nil
         ) ;_  list
        ) ;_  vl-catch-all-apply
       ) ;_  vl-catch-all-error-p
  ) ;_  not
  (progn (setq
          lst (mapcar
               (function (lambda (l / i c)
                          (vlax-invoke-method
                           ADORecordset
                           "Open"
                           (strcat "SELECT * FROM [" l "]")
                           ADOConnect
                           1
                           3
                           nil
                          ) ;_  vlax-invoke-method
                          (setq i
                                (length
                                 (car (vlax-safearray->list
                                       (vlax-variant-value
                                        (vlax-invoke-method ADORecordset "GetRows" 65535)
                                       ) ;_  vlax-variant-value
                                      ) ;_  vlax-safearray->list
                                 ) ;_  car
                                ) ;_  length
                          ) ;_  setq
                          (vlax-invoke-method ADORecordset "Close")
                          (while (not (zerop i))
                           (vlax-invoke-method
                            ADORecordset
                            "Open"
                            (strcat "SELECT * FROM ["
                                    l
                                    "a"
                                    (itoa i)
                                    ":IV"
                                    (itoa i)
                                    "]"
                            ) ;_  strcat
                            ADOConnect
                            1
                            3
                            nil
                           ) ;_  vlax-invoke-method
                           (setq c (cons
                                    (car
                                     (apply
                                      (function mapcar)
                                      (cons
                                       'list
                                       (mapcar
                                        (function
                                         (lambda (a)
                                          (mapcar
                                           (function (lambda (b) (vlax-variant-value b))
                                           ) ;_  function
                                           a
                                          ) ;_  mapcar
                                         ) ;_  lambda
                                        ) ;_  function
                                        (vlax-safearray->list
                                         (vlax-variant-value
                                          (vlax-invoke-method
                                           ADORecordset
                                           "GetRows"
                                           65535
                                          ) ;_  vlax-invoke-method
                                         ) ;_  vlax-variant-value
                                        ) ;_  vlax-safearray->list
                                       ) ;_  mapcar
                                      ) ;_  cons
                                     ) ;_  apply
                                    ) ;_  car
                                    c
                                   ) ;_  cons
                                 i (1- i)
                           ) ;_  setq
                           (vlax-invoke-method ADORecordset "Close")
                          ) ;_  while
                          (if (equal c '((nil) (nil)))
                           (list l)
                           (cons l c)
                          ) ;_  if
                         ) ;_  lambda
               ) ;_  function
               (mapcar
                (function (lambda (x)
                           (if (= (substr x 1 1) "'")
                            (substr x 2 (- (strlen x) 2))
                            x
                           ) ;_  if
                          ) ;_  lambda
                ) ;_  function
                (rec-rem-dupl
                 (caddr
                  (mapcar
                   (function
                    (lambda (a) (mapcar (function vlax-variant-value) a))
                   ) ;_  function
                   (vlax-safearray->list
                    (vlax-variant-value
                     (vlax-invoke-method
                      (vlax-invoke-method ADOConnect "OpenSchema" 4)
                      "GetRows"
                      65535
                     ) ;_  vlax-invoke-method
                    ) ;_  vlax-variant-value
                   ) ;_  vlax-safearray->list
                  ) ;_  apply
                 ) ;_  caddr
                ) ;_  rec-rem-dupl
               ) ;_  mapcar
              ) ;_  mapcar
         ) ;_  setq
         (vlax-invoke-method ADOConnect "Close")
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         lst
  ) ;_  progn
  (progn
   (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close"))
   (vlax-release-object ADORecordset)
   (vlax-release-object ADOConnect)
   (setq ADORecordset nil
         ADOConnect nil
   ) ;_  setq
   nil
  ) ;_  progn
 ) ;_  if
) ;_  defun

(defun c:gx (/ A B F L)
 ;;пример для экселя...
 ;; c автоматическим созданием блоков отметок.
 (vl-load-com)
 (if (setq f (getfiled "Укажите файл с точками графика" "" "xls" 0))
  (progn
   (if (null (tblobjname "BLOCK" "Отметка графика"))
    (mapcar 'entmakex
            '(((0 . "BLOCK")
               (100 . "AcDbEntity")
               (67 . 0)
               (8 . "0")
               (100 . "AcDbBlockBegin")
               (70 . 0)
               (10 0.0 0.0 0.0)
               (2 . "Отметка графика")
               (1 . "")
              )
              ((0 . "HATCH")
               (100 . "AcDbEntity")
               (410 . "Model")
               (62 . 0)
               (100 . "AcDbHatch")
               (10 0.0 0.0 0.0)
               (210 0.0 0.0 1.0)
               (2 . "SOLID")
               (70 . 1)
               (71 . 0)
               (91 . 1)
               (92 . 1)
               (93 . 1)
               (72 . 2)
               (10 0.0 0.0 0.0)
               (40 . 0.5)
               (50 . 0.0)
               (51 . 6.28319)
               (73 . 1)
               (97 . 0)
               (75 . 0)
               (76 . 1)
               (98 . 1)
               (10 0.0 0.0 0.0)
               (451 . 0)
               (460 . 0.0)
               (461 . 0.0)
               (452 . 1)
               (462 . 1.0)
               (453 . 2)
               (463 . 0.0)
               (463 . 1.0)
               (470 . "LINEAR")
              )
              ((0 . "ENDBLK"))
             )
    ) ;_  progn
   ) ;_  if
   (setq l (GET_xl f))
   (foreach x (mapcar 'cdr l)
    (if x
     (entmakex
      (append
       (list '(0 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(410 . "Model")
             '(100 . "AcDbPolyline")
             (cons 90 (length x))
       ) ;_  list
       (mapcar
        '(lambda (a)
          (setq a (list 10 (car a) (cadr a)))
          (entmakex (list '(0 . "INSERT") '(2 . "Отметка графика") a))
          a
         ) ;_  lambda
        x
       ) ;_  mapcar
      ) ;_  append
     ) ;_  entmakex
    ) ;_  if
   ) ;_  foreach
   (princ)
  ) ;_  progn
 ) ;_  if
)
(defun c:gxm (/ A B F L)
 ;;пример для экселя...
 ;; c запросом масштаба и автоматическим созданием блоков отметок.
 (vl-load-com)
 (if (setq f (getfiled "Укажите файл с точками графика" "" "xls" 0))
  (progn
   (if (null (tblobjname "BLOCK" "Отметка графика"))
    (mapcar 'entmakex
            '(((0 . "BLOCK")
               (100 . "AcDbEntity")
               (67 . 0)
               (8 . "0")
               (100 . "AcDbBlockBegin")
               (70 . 0)
               (10 0.0 0.0 0.0)
               (2 . "Отметка графика")
               (1 . "")
              )
              ((0 . "HATCH")
               (100 . "AcDbEntity")
               (410 . "Model")
               (62 . 0)
               (100 . "AcDbHatch")
               (10 0.0 0.0 0.0)
               (210 0.0 0.0 1.0)
               (2 . "SOLID")
               (70 . 1)
               (71 . 0)
               (91 . 1)
               (92 . 1)
               (93 . 1)
               (72 . 2)
               (10 0.0 0.0 0.0)
               (40 . 0.5)
               (50 . 0.0)
               (51 . 6.28319)
               (73 . 1)
               (97 . 0)
               (75 . 0)
               (76 . 1)
               (98 . 1)
               (10 0.0 0.0 0.0)
               (451 . 0)
               (460 . 0.0)
               (461 . 0.0)
               (452 . 1)
               (462 . 1.0)
               (453 . 2)
               (463 . 0.0)
               (463 . 1.0)
               (470 . "LINEAR")
              )
              ((0 . "ENDBLK"))
             )
    ) ;_  progn
   ) ;_  if
   (setq s (mapcar '(lambda (x)
                     (if x
                      x
                      1
                     ) ;_  if
                    ) ;_  lambda
                   (list (getreal "\nВведите масштаб по Х [1]:  ")
                         (getreal "\nВведите масштаб по Y [1]:  ")
                   ) ;_  list
           ) ;_  mapcar
   ) ;_  setq
   (setq l (GET_xl f))
   (foreach x (mapcar 'cdr l)
    (if x
     (entmakex
      (append
       (list '(0 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(410 . "Model")
             '(100 . "AcDbPolyline")
             (cons 90 (length x))
       ) ;_  list
       (mapcar
        '(lambda (a)
          (setq a (list 10 (* (car s) (car a)) (* (cadr s) (cadr a))))
          (entmakex (list '(0 . "INSERT") '(2 . "Отметка графика") a))
          a
         ) ;_  lambda
        x
       ) ;_  mapcar
      ) ;_  append
     ) ;_  entmakex
    ) ;_  if
   ) ;_  foreach
   (princ)
  ) ;_  progn
 ) ;_  if
)
Red Nova вне форума  
 
Непрочитано 18.05.2013, 20:02
#95
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


что-то похожее.
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
 
Непрочитано 18.05.2013, 21:39
#96
VVA

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


Red Nova, Думаю проблема здесь не в 2013, а в 64-разрядной винде.
провайдера microsoft.jet.oledb для x64 - не существует?
microsoft jet .oledb.4.0 for windows 7 64 bit
Microsoft Access Database Engine 2010 Redistributable
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.05.2013, 21:51
#97
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Главное, чтобы в Windows x64 не был установлен MS Office x86, иначе провайдера не найдёт. Я сталкивался с подобным, когда на Windows 7 x64 был установлен MS Office 2003 x86. Переустановка офиса на версию x64 решила проблемы (установил 2013-й x64). Если в указанном выше коде проблема действительно с провайдером, то вот возможные варианты (выбрать нужно тот, который соответствует установленному офису):
Цитата:
...
Строка подключения. Возможно на некоторых машинах нужно будет указать др. провайдера:
20: MS Access 2003: Provider=Microsoft.Jet.OLEDB.4.0
21: MS Access 2007: Provider=Microsoft.ACE.OLEDB.12.0
22: MS Access 2010: Provider=Microsoft.ACE.OLEDB.12.0
23: MS Access 2013: Provider=Microsoft.ACE.OLEDB.12.0 или Provider=Microsoft.ACE.OLEDB.15.0
...
В строке кода
Код:
[Выделить все]
 (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
нужно заменить провайдера на нужный вариант.

P.S. Повторюсь - это если дело действительно в провайдере (код Евгения я не запускал).
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
 
Автор темы   Непрочитано 18.05.2013, 22:36
#98
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,974
Отправить сообщение для Red Nova с помощью Skype™


Спасибо за ответы.
hwd,
Офис стоит 32 битный. Попробую сис админа уговорить поменять на 64.
Red Nova вне форума  
 
Непрочитано 18.05.2013, 22:37
#99
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Цитата:
Сообщение от Red Nova Посмотреть сообщение
Офис стоит 32 битный.
Ну, тогда всё ясно (если Windows x64). Если админ не захочет переустанавливать, то выше я дал ссылку - возможно поможет на некоторое время (две из трёх команд должны будут работать, а третья (вариант с MS Access) не будет, по той же причине с провайдерами).
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
 
Непрочитано 20.05.2013, 17:31
#100
mahabala


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


а есть инструкция по пользованию GetPointFormExcel?
запутался все всем этом. какие столбцы в экселе и для чего нужны?(первые четыре - понятно - X\Y\Z\имя, а возможны еще два?)
что делать с остальными файлами в папке?(я закинул всю папку в пути поиска акада)
-не рисует.

у меня такие сообщения:
Excel Object Library was not found!
и
Getting Sheet Names from Excel...неверный тип аргумента: streamp nil"
после чего пытается узнать у меня "противоположный угол или [Линия/РМн-угол/СМн-угол]:"
mahabala вне форума  
 
Непрочитано 01.10.2014, 16:06
#101
bridgeconst

проектирование
 
Регистрация: 29.11.2007
Москва
Сообщений: 308


Если пишет:
Excel Object Library was not found!
то значит, что путь к exe-шнику и библиотеки Exсel не совпадает с тем, что в коде прописано.
Откройте lsp файл и руками поправьте строчки
((findfile (strcat sysDrive "\\Program Files\\Microsoft Office\\Office\\Excel8.olb")))
((findfile (strcat sysDrive "\\Program Files\\Microsoft Office\\Office\\Excel9.olb")))
((findfile (strcat sysDrive "\\Program Files\\Microsoft Office\\Office\\Excel10.olb")))
((findfile (strcat sysDrive "\\Program Files\\Microsoft Office\\Office\\Excel.exe")))
((findfile (strcat sysDrive "\\Program Files\\Microsoft Office\\Office10\\Excel.exe")))
((findfile (strcat sysDrive "\\Program Files\\Microsoft Office\\Office11\\Excel.exe")))

В моем случае exe-шник Exсel лежал в папке Office12. Исправил одну цифру, сохранил, перезапустил - заработало.
Врообще решение проблемы описано в
http://www.jefferypsanders.com/autolisp_XL_Help.html
__________________
Обмениваю незнание на время.
bridgeconst вне форума  
 
Непрочитано 14.09.2016, 08:13 прорисовка точек из excel
#102
Nadinka

инженер-технолог
 
Регистрация: 24.07.2013
на севере
Сообщений: 17


VVA, Олег (jr.), доброго дня!
Помогите, пожалуйста, разобраться. VVA, спасибо за Вашу помощь, Ваша программа прорисовывает 20 тысяч точек из excel файла, только столбец D не прорисовывает. Выше советовали пересохранить в формате csv. Тогда вопрос у меня, как указать этот файл на обработку, если окно диалога позволяет выбрать файлы только двух типов:xlsx, xls? не дает выбрать файл csv.
Если координат меньше 20, то программа работает на ура и все прорисовывает. Может проблема в слишком большом количестве информации (несколько часов выполнялась прорисовка)?
Вложения
Тип файла: rar координаты.rar (1.47 Мб, 26 просмотров)
Nadinka вне форума  
 
Непрочитано 14.09.2016, 08:48
#103
trir


 
Регистрация: 18.12.2010
Сообщений: 3,458


csv не так делается

_Aeccimportpoints - 3 минуты

Последний раз редактировалось trir, 14.09.2016 в 08:57.
trir на форуме  
 
Непрочитано 14.09.2016, 12:16
#104
Nadinka

инженер-технолог
 
Регистрация: 24.07.2013
на севере
Сообщений: 17


Цитата:
Сообщение от trir Посмотреть сообщение
csv не так делается

_Aeccimportpoints - 3 минуты
trir, расскажите, пожалуйста, что это за команда _Aeccimportpoints и как ее использовать?
Nadinka вне форума  
 
Непрочитано 14.09.2016, 12:19
#105
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,741


trir, тебе каждый раз напоминать надо, чтобы ты уточнял, про какое ПО ты говоришь?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.09.2016, 12:43
#106
trir


 
Регистрация: 18.12.2010
Сообщений: 3,458


Цитата:
trir, тебе каждый раз напоминать надо, чтобы ты уточнял, про какое ПО ты говоришь?
а интрига?

Цитата:
что это за команда _Aeccimportpoints и как ее использовать?
AutoCAD Civil 3D
trir на форуме  
 
Непрочитано 14.09.2016, 12:55
#107
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,741


Offtop: trir, интрига, как и шутка, бывает двух типов. Первый тип: сколько бы раз ни схохмил - ты молодец. Второй: первый раз - круто, второй и дальше - уже не катит. Твоя "интрига" уже вполне тянет на второй сорт.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.09.2016, 12:59
#108
trir


 
Регистрация: 18.12.2010
Сообщений: 3,458


Offtop: там есть префикс _Aecc который однозначно определяет откуда эта команда - если человек этого не знает, ему полезно будет это узнать
trir на форуме  
 
Непрочитано 14.09.2016, 13:10
#109
Nadinka

инженер-технолог
 
Регистрация: 24.07.2013
на севере
Сообщений: 17


trir, спасибо буду знать. Но мы работаем только с AutoCAD, ADT, в данный момент будем переходить на 2015.
Все-таки, конечно хотелось бы добиться помощи в решении моего вопроса. Очень жаль, что разработчики данной программы пока не выходят на связь.
Nadinka вне форума  
 
Непрочитано 14.09.2016, 13:26
#110
trir


 
Регистрация: 18.12.2010
Сообщений: 3,458


а что это за данные?
trir на форуме  
 
Непрочитано 14.09.2016, 13:53
#111
Nadinka

инженер-технолог
 
Регистрация: 24.07.2013
на севере
Сообщений: 17


Цитата:
Сообщение от trir Посмотреть сообщение
а что это за данные?
Если честно не знаю. Просто пользователь попросил помочь нарисовать точки по координатам. Я попросила его заполнить координаты в такой вот форме excel, чтобы воспользоваться этой программкой.
Если узнать что это за данные, это чем-то поможет решению вопроса?
Дело в том, что для маленького количества точек все работает замечательно, но когда я прогнала для 20 тысяч точек, то получила только точки без пометок.
Nadinka вне форума  
 
Непрочитано 14.09.2016, 14:27
#112
trir


 
Регистрация: 18.12.2010
Сообщений: 3,458


проще написать dxf

python:
Код:
[Выделить все]
import csv

def printPoint(file, x, y, z):
	text_file.write("  0\n")
	text_file.write("POINT\n")
	text_file.write("100\n")
	text_file.write("AcDbEntity\n")
	text_file.write("  8\n")
	text_file.write("0\n")	
	text_file.write("100\n")
	text_file.write("AcDbPoint\n")	
	text_file.write(" 10\n")
	text_file.write(str(x) + "\n")
	text_file.write(" 20\n")
	text_file.write(str(y) + "\n")
	text_file.write(" 30\n")
	text_file.write(str(z) + "\n")	

with open('C:\\work\\fff.txt', 'rb') as csvfile:
	wreader = csv.reader(csvfile, delimiter=';')
	
	with open("C:\\work\\Output.dxf", "w") as text_file:	
		text_file.write("  0\n")
		text_file.write("SECTION\n")
		text_file.write("  2\n")
		text_file.write("ENTITIES\n")
		#print point
		for row in wreader:
			printPoint(text_file, row[0], row[1], row[2])		
		text_file.write("  0\n")	
		text_file.write("ENDSEC\n")
		text_file.write("  0\n")
		text_file.write("EOF\n")
trir на форуме  
 
Непрочитано 14.09.2016, 22:36
#113
VVA

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


Цитата:
Сообщение от Nadinka Посмотреть сообщение
(несколько часов выполнялась прорисовка)
CSV - текстовый файл. Разделитель между столбцами - точка с запятой. Разделитель целой и дробной части - точка или запятая, без разницы
Код:
[Выделить все]
(defun C:CSV2PT	(/ *error* adoc pt-list data txt fl file)
  (vl-load-com)
  (defun *error* (msg) (princ msg) (vla-endundomark adoc))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)
  (setq file (getfiled "Select a CSV File" "" "csv;txt" 8))
  (setq fl (open file "r"))
  (while (setq txt (read-line fl))
    (setq data
	   (mapcar
	     '(lambda (x)
		(VL-STRING-TRIM " \t\n" (VL-STRING-TRANSLATE ",'" ". " x))
	      )
	     (str-str-lst txt ";")
	   )
    )
    (VL-CATCH-ALL-APPLY
      '(lambda ()
    (setq pl-list (list	(atof (car data))
			(atof (cadr data))
			(atof (caddr data))
		  )
    )
	 (entmakex
	   (list
	     '(0 . "POINT")
	     '(100 . "AcDbEntity")
	     '(410 . "Model")
	     '(100 . "AcDbPoint")
	     (cons 10 pl-list)
	     '(210 0.0 0.0 1.0)
	   )
	 )
	 (setq txt (cadddr data))
	 (if (and txt (/= txt ""))
	   (entmake (list '(0 . "TEXT")
			  '(100 . "AcDbEntity")
			  '(100 . "AcDbText")
			  (cons 10 pl-list)
			  (cons 1 txt)
			  (cons 40 (getvar "TEXTSIZE"))
			  '(72 . 0)
			  (cons 50 0)
			  (cons 10 pl-list)
		    ) ;_ end of list
	   )
	 )
       )
    )
  )
  (close fl)
  (vla-endundomark adoc)
  (command "_ZOOM" "_E")
  (princ)
)
 ;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.caduser.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond	((= str "") nil)
	((setq i (vl-string-search pat str))
	 (cons (substr str 1 i)
	       (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
	 ) ;_  cons
	)
	(t (list str))
  ) ;_  cond
) ;_  defun
(princ "\nType CSV2PT in command line")
(princ)
Вложения
Тип файла: zip 11-453 ряд в3.zip (115.3 Кб, 28 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 14.09.2016 в 22:48.
VVA вне форума  
 
Непрочитано 15.09.2016, 08:10
#114
Nadinka

инженер-технолог
 
Регистрация: 24.07.2013
на севере
Сообщений: 17


VVA, премного благодарна Вам. Этот код работает и все прорисовывается.
Спасибо еще раз большое за Вашу помощь!
Nadinka вне форума  
 
Непрочитано 15.09.2016, 08:36
#115
trir


 
Регистрация: 18.12.2010
Сообщений: 3,458


а может лучше блок вставлять, можно сразу из Excel'я
trir на форуме  
 
Непрочитано 06.04.2017, 06:02
#116
Titli-pytli


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


После попытки вставить "note" из экселя используя программу http://www.jefferypsanders.com/autolisp_IMPORTXYZ.html , автокад возвращает:

Getting Excel Data...
Currently retrieving cells in Row 25 of 98
Currently retrieving cells in Row 50 of 98
Currently retrieving cells in Row 75 of 98 Done.
Exiting EXCEL... Done.
Displaying data... Done.
Saving variables from dialog box... Done.
Placing notes...Неизвестная команда "IMPORTXYZ".

Как можно победить?
Titli-pytli вне форума  
 
Непрочитано 06.04.2017, 09:20
#117
frostmourn


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


Как минимум нужно в командах и опциях подчёркивание добавить.
frostmourn вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Создание графика в AutoCAD на основе txt или xls файла

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 269 22.07.2019 17:19
запуск программы из AutoCADа kminas Программирование 19 15.06.2012 13:42
Растр в AutoCad - внутрь файла. Как? dep AutoCAD 3 10.12.2007 16:38
Одна из целей: Создание экспертных систем на базе AutoCAD. Сергей Юрьевич Программирование 9 01.01.2005 15:17