[Кочетков Андрей]

Коллеги помогите пожалуйста написать такой лисп:
изменение Z-координаты каждого объекта TEXT и MTEXT
сначала в 1 (Z=1)
потом в 0 (Z=0)

Лисп нужен в связи с недавно обнаруженной проблемой, когда текст на экране отображается с искажениями, но печатается нормально.
Проблема в том, что по непонятным причинам Z-координаты текста устанавливаются в очень маленькую величину и даже в свойствах отображается, как 0.
При ручном изменении Z-координаты в 1, потом в 0 - все становится нормально.

[Кулик Алексей aka kpblc]

Ну, если тебе flatten не подходит, попробуй:

Код:

[Выделить все]

(defun c:set-text-z-to-zero (/ adoc layers selset)
  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (setq selset (ssget "_X" '((0 . "*TEXT"))))
    (progn
      (setq layers (mapcar
                     (function
                       (lambda (x / res)
                         (setq res (list (cons "ent" x)
                                         (cons "locked" (vla-get-lock x))
                                         (cons "freeze" (vla-get-freeze x))
                                         ) ;_ end of list
                               ) ;_ end of setq
                         (foreach prop '("locked" "freeze")
                           (vl-catch-all-apply
                             (function
                               (lambda ()
                                 (vlax-put-property x prop :vlax-false)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             ) ;_ end of vl-catch-all-apply
                           ) ;_ end of foreach
                         res
                         ) ;_ end of LAMBDA
                       ) ;_ end of function
                     ((lambda (/ lst)
                        (vlax-for item (vla-get-layers adoc)
                          (setq lst (cons item lst))
                          ) ;_ end of vlax-for
                        ) ;_ end of lambda
                      )
                     ) ;_ end of mapcar
            selset (mapcar (function vlax-ename->vla-object)
                           ((lambda (/ tab item)
                              (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
            ) ;_ end of setq
      (foreach ent selset
        (vl-catch-all-apply
          (function
            (lambda ()
              (if (equal (vlax-safearray->list (vlax-variant-value (vla-get-normal ent))) '(0. 0. 1.))
                (vla-put-insertionpoint
                  ent
                  ((lambda (/ pt)
                     (setq pt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent))))
                     (vlax-3d-point
                       (list (car pt) (cadr pt) 0.)
                       ) ;_ end of vlax-3d-point
                     ) ;_ end of lambda
                   )
                  ) ;_ end of vla-put-InsertionPoint
                ) ;_ end of if
              ) ;_ end of lambda
            ) ;_ end of function
          ) ;_ end of VL-CATCH-ALL-APPLY
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[Кочетков Андрей]

Алексей спасибо за код. Хотел уточнить: эта программа сначала делает Z=1 потом Z=0 или сразу Z=0 ?

[Дима_]

Мне почему-то кажется что если обнулять програмно - то перевод в еденицу не понадобиться, но сделал как "прошенно" - запускать ztext

Код:

[Выделить все]

(vl-load-com)
(defun c:ztext ()
(mapcar '(lambda (lst)
(setq lst (entmod (subst (append  (reverse (cdr (reverse (assoc 10 lst)))) '(1.0)) (assoc 10 lst) lst)))
(entmod (subst (append  (reverse (cdr (reverse (assoc 10 lst)))) '(0.0)) (assoc 10 lst) lst))
);end of lambda
(mapcar 'entget (sstolist (ssget (list (cons 0 "*text"))))))
(princ)
);end of ztext

(defun sstolist (ss / i lst); конвертирует набор в список
(setq i 0)
(if ss
(repeat (sslength ss)
(setq lst (append lst (list (ssname ss i))) i (1+ i))
));end of repeat & if
lst
);end of sstolist

[Кулик Алексей aka kpblc]

Кочетков Андрей, нет, там принудительно устанавливается Z=0. для объектов однострочного и многострочного текста (построенных в мировой системе координат). Без присвоения 1.

[Кочетков Андрей]

Понял!
Дима, Алексей еще раз спасибо!