Комментарии

1. Vildar пишет:

   28 Декабрь 2010 в 18:03

   При запуск (es_export_database), акад пишет:
   ; ошибка: no function definition: FUNTION

   Подправил на Function, ну думаю опечатка, и опять запустил
   ; ошибка: no function definition: nil

   Все я в тупике.
   Подскажите плиз.
2. Кулик Алексей aka kpblc пишет:

   29 Декабрь 2010 в 1:03

   Доброго. Во-первых, спасибо за замеченную опечатку. Во-вторых, весьма странно: я только что специально прогнал код на практически пустом файле (AutoCAD 2011 Eng 64 bit + SP), все сработало корректно.
   Что-то странное – код не прикрепить никак
3. Vildar пишет:

   29 Декабрь 2010 в 10:07

   Если можно уточню.
   Сообщение – ; ошибка: no function definition: nil
   Выскакивает в функции es_export_database, в строке:

   (vl-remove 'nil
                      (mapcar 'vlax-ename->vla-object (reverse lm))
                      ) ;_ end of vl-remove

   А еще точнее в этом месте этой строки: (reverse lm)
   Может это поможет вам разобраться. Спасибо.
   Autocad2008 sp1, winXP, 32bit.
4. Кулик Алексей aka kpblc пишет:

   29 Декабрь 2010 в 18:33

   Доброго. Только что проверил на AutoCAD 2008 Eng + SP 32 bit и AutoCAD 2011 Eng + SP 32 bit, Windows Vista Home 32 bit. Ошибка есть. Но, что самое интересное – ошибка появляется, если код выполнять не пошагово. После хотя бы одного прохода пошагово все работает корректно.
   Есть, конечно, вариант: попытаться сначала сформировать полноценный список, и лишь потом его выводить в файл. Но мне почему-то такой подход не кажется правильным
   Как бороться – не знаю, а Эдуарда сейчас уже сложно заманить на решение лисповых задач Если чего получится – попробую сделать решение. Хотя особых надежд на это я бы не возлагал…
5. Vildar пишет:

   30 Декабрь 2010 в 12:44

   Алексей с Наступающим!
   А можно попросить выложить кусочек результатов этой программы. Меня только это интересует. Лисп мне сложно понять. А увидев результат, я сразу, надеюсь, пойму что же делает эта программа (функция).

   Спасибо.
6. @rey7 пишет:

   4 Март 2011 в 8:13

   так работает:

   ;;;Функция преобразования числа из шестнадцатиричной в десятичную систему исчисления
   ;;;аргументы :
   ;;;а - число в шестнадцатиричной системе исчисления , тип string
   ;;;переменные:
   ;;;listst - список степеней числа 16. Длина списка равна количеству символов аргумента
   (defun c:h-dec (a / i listst)
     (setq i (strlen a))
     (repeat i
       (setq listst (cons (expt 16 (1- i)) listst))
       (setq i (1- i))
       ) ;_ end of repeat
     (rtos
       (apply
         (function +)
         (mapcar
           (function *)
           (reverse
             (mapcar
               (function
                 (lambda (x)
                   (cond
                     (
                      (vl-symbolp (read (chr x)))
                      (+ (vl-position (chr x) '("A" "B" "C" "D" "E" "F"))
                         10
                         ) ;_ end of +
                      )
                     (t
                      (atoi (chr x))
                      )
                     ) ;_ end of cond
                   ) ;_ end of lambda
                 ) ;_ end of function
               (vl-string->list a)
               ) ;_ end of mapcar
             ) ;_ end of reverse
           (mapcar (function float) listst)
           ) ;_ end of mapcar
         ) ;_ end of apply
       ) ;_ end of rtos
     ) ;_ end of defun
   
   ;;;Функция преобразования числа из десятичной в шестнадцатиричную систему исчисления.
   ;;;Аргументы:
   ;;;b- число в десятичной системе исчисления , тип integer
   ;;;Переменные:
   ;;;blist - число в шестнадцатеричной системе исчисления , тип string
   (defun c:dec-h (b / blist list16)
     (setq list16 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))
     (while (>= b 16)
       (setq blist (cons (fix (rem b 16)) blist)
             b     (fix (/ b 16.00))
             ) ;_ end of setq
       ) ;_ end of while
     (apply (function strcat)
            (mapcar(function(lambda (x)
                       (nth x list16)
                       ))
                    (setq blist (cons b blist))
                    ) ;_ end of mapcar
            ) ;_ end of apply
     ) ;_ end of defun
   
   ;;; Функция экспорта базы данных рисунка в текстовой файл. Производит поиск графических и не графических примитивов в
   ;;; базе
   ;;; рисунка
   ;;;перебирая метки с 1 до метки последнего созданного примитива , выводит свойства примитивов в текстовой файл
   ;;; в виде :  "класс объекта"  "метка"  "метка в десятичном представлении" "имя объекта" (при его наличии)
   ;;; аргументов нет
   ;;; переменные :
   ;;;filename - имя файла вывода данных
   ;;;dsk - дескриптор файла
   ;;;lp - имя последнего созданного примитива
   ;;;m - метка примитива
   ;;;lm - список меток
   (defun c:es_export_database (/ lm filename dsk lp m)
     (setq i 1)
     (if (and
           (setq filename (getfiled "Файл вывода " "C:\\" "xls" 1))
             ;имя файла вывода
           (setq dsk (open filename "a")) ;дескриптор файла
           (setq lp (entmakex '((0 . "point") (10 0 0 0))))
             ; создаем примитив для определения количества повторов цикла перебора меток
           ) ;_ end of and
       (progn
         (repeat (1- (atoi (h-dec (cdr (assoc 5 (entget lp))))))
             ;цикл перебора меток
           (if
             (setq m (handent (dec-h i)))
              (setq lm (cons m lm)) ; список содержащий метки существующих в чертеже примитивов
              ) ;_ end of if
           (setq i (1+ i)
                 ) ;_ end of setq
           ) ;_ end of repeat
         (entdel lp) ; удаляем рабочий примитив
         (mapcar
           '(lambda (x / nam prn)
              (setq prn (strcat (vla-get-objectname x)
                                "\t"
                                (vla-get-handle x)
                                "\t"
                                (h-dec (vla-get-handle x))
                                "\t"
                                (rtos (vla-get-objectid x) 2 0)
                                "\t"
                                ) ;_ end of strcat
                    ) ;_ end of setq
              (if
                (and
                  (vlax-property-available-p x 'name)
                  (not (vl-catch-all-error-p
                         (setq
                           nam (vl-catch-all-apply 'vla-get-name (list x))
                           ) ;_ end of setq
                         ) ;_ end of vl-catch-all-error-p
                       ) ;_ end of not
                  ) ;_ end of and
                 (setq prn (strcat prn nam "\t"))
                 (setq prn (strcat prn "\t"))
                 ) ;_ end of if
              (princ (strcat prn "\n") dsk)
              ) ;_ end of lambda
           (vl-remove 'nil
                      (mapcar 'vlax-ename->vla-object (reverse lm))
                      ) ;_ end of vl-remove
           ) ; функция печати данных примитива в файл
         (close dsk)
         ) ;_ end of progn
       ) ;_ end of if
     ) ;_ end of defun