Получение ObjectID для применения в полях

Как тут выяснилось, последние 64-разрядные версии (начиная с 2018 точно) для приведенного кода возвращают некорректный результат. В принципе, это было ожидаемо: лисп умеет работать только с 32-разрядными целыми, и при попытке подсунуть ему 64-разрядное целое происходит переполнение. Как следствие - результат некорректный.

Для примера - попробуйте посчитать в лиспе сначала

1
(1- (expt 2 31))

А потом

1
(expt 2 31)

Живейший пример переполнения.
Евгений Елпанов подсказал решение (правда, оно гарантированно работает только для текущего документа). Суть примерно следующая: преобразовываем ename-представление в строку и получаем оттуда идентификатор объекта. Идентификатор хранится в 16-ричном виде, поэтому преобразовываем его в десятичный:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
(defun _kpblc-get-objectid-for-field (obj / hex2dec)
                                     ;|
*    Получение строкового значения ObjectId объекта. В частности, для использования в полях
*    Параметры вызова:
  obj    указатель на объект. vla- либо ename-
*    Примеры вызова:
(_kpblc-get-objectid-for-field
|;

  (defun hex2dec (s / f)
    ;; Код Евгения Елпанова
    (defun f (l s / a)
      (cond ((and s l)
             (f (cons (rem (setq a (+ (* (car l) 16) (car s))) 10) (f (cdr l) (list (/ a 10)))) (cdr s))
             )
            ((> (car s) 9) (f nil (cons (rem (car s) 10) (f nil (list (/ (car s) 10))))))
            (l)
            ((if (not (equal s '(0)))
               s
               nil
               ) ;_ end of if
             )
            ) ;_ end of cond
      ) ;_ end of defun
    (setq s (mapcar (function (lambda (a) (- a 48)))
                    (vl-string->list (vl-string-translate "ABCDEF" ":;<=>?" (strcase s)))
                    ) ;_ end of mapcar
          ) ;_ end of setq
    (apply (function strcat) (mapcar (function itoa) (reverse (f '(0) s))))
    ) ;_ end of defun
  (if (setq obj (cond ((= (type obj) 'vla-object) (vlax-vla-object->ename obj))
                      ((= (type obj) 'ename) obj)
                      ) ;_ end of cond
            ) ;_ end of setq
    (progn (setq obj (vl-princ-to-string obj))
           (hex2dec (vl-string-trim ": >" (substr obj (1+ (vl-string-search ":" obj)))))
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Исходник отдельно не загружаю.

Размещено в AutoCAD, Код LISP, Разное, Функции LISP · Метки: ,



Поделитесь своим мнением


Я не робот.