Значение координаты Z в строку текста

Поступила мне тут просьба - в файле dwg есть большое (больше 1000) объектов TEXT и MTEXT, у которых изменена точка вставки по оси 0z. В эти объекты надо "вбить" значение их высоты с точностью до 2 знаков после запятой.

Недолгие расспросы определили практически тепличные условия:

  1. Все объекты созданы в мировой системе координат
  2. Текушая система координат - мировая
  3. Результат должен быть именно в текущей (мировой) системе координат

Поскольку я лентяй, я нарисовал достаточно простую программку:

Код: [Выделить]
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
39
40
41
42
43
44
45
46
47
(vl-load-com)

(defun c:h2str (/ adoc selset err err_lst)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type (setq selset (vl-catch-all-apply (function (lambda () (ssget "_:L" '((0 . "*TEXT"))))))))
         'pickset
         ) ;_ end of =
    (progn
      (foreach ent (mapcar (function vlax-ename->vla-object)
                           ((lambda (/ item tab)
                              (repeat (setq tab  nil
                                            item (sslength selset)
                                            ) ;_ end setq
                                (setq tab (cons (ssname selset (setq item (1- item))) tab))
                                ) ;_ end of repeat
                              ) ;_ end of lambda
                            )
                           ) ;_ end of mapcar
        (if (vl-catch-all-error-p
              (setq err (vl-catch-all-apply
                          (function
                            (lambda (/ z)
                              (setq z (* 0.01 (* 100 (caddr (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent))))))
                                    z (if (= (rem (fix (* 10 (- (* (abs z) 100) (fix (* (abs z) 100))))) 5) 0)
                                        (rtos (* 0.01 (fix (* z 100))) 2 2)
                                        (rtos z 2 2)
                                        ) ;_ end of if
                                    ) ;_ end of setq
                              (if (not (vl-string-search "." z))
                                (setq z (strcat z ".00"))
                                (while (< (strlen (substr z (+ 2 (vl-string-search "." "55.6")))) 2) (setq z (strcat z "0")))
                                ) ;_ end of if
                              (vla-put-textstring ent z)
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                    ) ;_ end of setq
              ) ;_ end of vl-catch-all-error-p
          (setq err_lst (cons (vl-catch-all-error-message err) err_lst))
          ) ;_ end of if
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (foreach item err_lst (princ (strcat "\nОшибка назначения высоты для текста : " item)))
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Принцип работы прост: запрашиваем объекты, не лежащие на заблокированных слоях, и проходим по ним. Для каждого объекта получаем координаты его точки вставки (свойство InsertionPoint есть и у однострочного, и у многострочного текста), забираем координату Z, и приводим ее к строке с двумя знаками после запятой. Разделителем целой и дробной части принята точка (по условиям, которые мне выставили конечные потребители программки).
Работа кода проверена на AutoCAD 2002-2016, особых нареканий пока не выявлено.
Понятно, что как только в задачу вмешаются немировые системы координат, код быстро дополнится многочисленными trans. Но мне было легче ;)

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



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


Я не робот.