[olga87]

Здравствуйте Уважаемые программисты!
Подскажите пожалуйста, как исправить нижеприведенный лисп (AutoCAD 2008) для добавления текста под размерную линию, но с сохранением текущего размера.
Сейчас этот код при добавлении текста под размер сбрасывает размерное число до фактического ("<>"), а мне хотелось бы чтобы размерное число (какое бы оно ни было) сохранилось с добавлением текста под размерную линию.
Спасибо!

(defun c:addtext (/ line1 line2)
(setq line1 (getstring T "\nВведите вторую строку для размера: "))
(if (= line1 nil)(command))
(setq line2 (strcat "<>" "\\X" line1))
(command "_dimedit" "_n" line2)
)

[VVA]

Держи

Код:

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

(defun c:addtext (/ line1 line2) 
 (dimtexaddsuffix nil)
  (princ)
 )
;;Изменяет Text Override выбранных размеров
;; SuffixText - string to change SuffixText
;;               or nil to ask  SuffixText
(defun dimtexaddsuffix ( SuffixText / str Isrus ss lst *error* e1 i)
   (defun *error* (msg)(princ msg)
    (vla-endundomark(vla-get-activedocument (vlax-get-acad-object)))) ;_ end of defun
  (vl-load-com)
  (vla-startundomark(vla-get-activedocument (vlax-get-acad-object)))
  (setq Isrus (= (getvar "DWGCODEPAGE") "ANSI_1251"))
  (if (null SuffixText)
  (setq SuffixText
         (getstring t
                    (if Isrus
                      "\nНаберите значение второй строки для размера: "
                      "\nType text's second line value : "
                    ) ;_ end of if
         ) ;_ end of getstring
  ) ;_ end of setq
    )
 (if (= SuffixText nil)(setq SuffixText "")) ;_ end of if
 (if (and
       (= (type SuffixText) 'STR)
       (if Isrus
         (princ "\nВыберите размеры для замены SuffixText")
         (princ "\nSelect dimention for change SuffixText")
         ) ;_ end of if
       (setq ss (ssget "_:L" '((0 . "*DIMENSION"))))
       )
   (progn
   (setq i '-1)
  (repeat (sslength ss)
    (setq e1 (ssname ss (setq i (1+ i))))
    (if (eq (cdr(assoc 1 (setq lst (entget e1)))) "")
      (setq str (strcat "<>\\X" SuffixText))
      (setq str (strcat (cdr(assoc 1 lst)) "\\X" SuffixText))
      )
      (setq lst (subst (cons 1 str)(assoc 1 lst) lst))
    (entmod lst)(entupd e1)
  ) ;_ end of repeat
   )
   )
  (setq ss nil)
  (vla-endundomark
    (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end of vla-EndUndoMark
  (princ)
) ;_ end of defun
(princ "\nType addtext in command line")(princ)

[olga87]

Спасибо большое!