[WeMaN]

Господа, дорый день! Помнится, вроде натыкался я на програмку, которая позваляла делать следующее, напрмер стоит у нас пикет, который представляет из себя точку и надпись отметки (текст), так вот эти объекты без отметки уровня высоты, как то вроде было возможно взять текст из графы содержания и перенести в отметку z, именно находящейся рядом точки. Вот сейчас понадобилось мне данное действие, а программку найти не могу, но точно помню что где то про неё читал, кто нить может помочь в нахождении? Заранее спасибо!

[VVA]

Тема развилась здесь
Код из темы по ссылке (на всякий случай)

Код:

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

(defun C:Ztxt ( / objSet Point ptLst tmp1 tmp2 pat txtZList dst *error*)
(vl-load-com)
(defun *error*(msg)(princ msg)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))(princ))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(if (and
      (setq objSet(ssget "_:L" '((0 . "POINT"))))
      (setq Point (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
      (setq ptLst(mapcar 'cdr (mapcar '(lambda(x)(assoc 10 x))(mapcar 'entget Point))))
      (setq objSet nil objSet(ssget "_X" (list '(0 . "*TEXT")(cons 410 (getvar "CTAB")))))
      )
  (progn
    (setq tmp1 (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
    (setq tmp1 (mapcar '(lambda(x)(setq x (entget x))(list (cdr(assoc 10 x))(cdr(assoc 1 x)))) tmp1))
    (foreach pt ptlst
      (setq tmp2 (mapcar '(lambda(x)(list (distance pt (car x))(cadr x))) tmp1))
      (setq pat (car tmp2))
      (foreach dst tmp2 (if (< (car dst) (car pat))(setq pat dst)))
      (setq txtZList (cons (cadr pat) txtZList))
      )
    (setq txtZList (reverse txtZList))
    (setq txtZList (mapcar '(lambda(x)
                    (vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))
                   )txtZList))
    (mapcar '(lambda(ptObj pt Z)
               (vla-put-coordinates (vlax-ename->vla-object ptObj)
                (vlax-3d-point (list (car pt)(cadr pt) Z))
               )
               )
           Point ptLst (mapcar 'atof txtZList)
            )
    )
  )
  (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
  )
(princ "\nType Ztxt in command line")

[WeMaN]

Да, здесь почему то реже развиваются темы... Но главное что решение найдено!

[timoshetc]

можно ли подправить лисп, чтобы переносил не только из блока, а так же из текста, либо Мтекста