[arturbd]

Часто бывает нужно составить спецификацию габаритных размеров деталей. Внесение габаритов в спецификацию приходитсья вносить вручную. Имеет место человеческий фактор. Когда, скажем, вместо размера 69 вносишь 96 или 25 - 52 и тд. Неужели же нельзя одним-двумя кликами скопировать содержимое размера и вставить в нужное место, как например это можно делать с текстом с помощью G-Tools "изменение текста по шаблону.
Заранее всех благодарю

[Лиспер]

Вариант раз - использовать панель свойств, и оттуда копировать значение "Текст" или "Измерение". Вариант нумер два - использовать поле. Вариант три - использовать лисп или еще что-то подобного типа.

[arturbd]

Спасибо за ответ.
дело в том, что такого копирования приходится делать много.
Вариант первый: через свойства - это долговато,
второй - через поле еще дольше и нет такой необходимости.
Вот с лиспом как? этого не знаю. Если можно поподробней. надо чтобы процесс был быстрый и неутомительный как с примером теста через G-Tools.

[Vova]

http://www.caduser.ru/forum/index.ph...D=44&TID=21894

[maks-ufa]

А если тупо скопировать чертеж рядом, разбить его, взять размеры...?

[VVA]

Сообщение от arturbd Вот с лиспом как? этого не знаю. Если можно поподробней. надо чтобы процесс был быстрый и неутомительный как с примером теста через G-Tools.

Копирование в буфер обмена
Команда CopyDim

Код:

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

(defun C:CopyDim ( / ss )
  (vl-load-com)
  (and
    (setq ss (ssget "_:S" '((0 . "*DIMENSION"))))
    (copyToclipboard (dim-get-text-string (ssname ss 0)))
  )
  )

;  ! ***************************************************************************
;; !                           copyToclipboard
;; ! ***************************************************************************
;; ! Function : Copy text to clipboard
;; ! Argument : 'str'     - String
;; ! Returns  : nil
;; see http://www.theswamp.org/index.php?topic=21764.new
;; ! ****************************************************************************

(defun copyToclipboard ( text / htmlfile result)
 (setq result
        (vlax-invoke
            (vlax-get
                (vlax-get
                    (setq htmlfile (vlax-create-object "htmlfile"))
                   'ParentWindow
                )
               'ClipBoardData
            )
           'SetData
            "Text"
            text
        )
    )

    (vlax-release-object htmlfile)
    result
)
(defun dim-get-text-string ( dim / str)
 (setq str "")
   (vlax-for item (vla-item (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                       ) ;_ end of vla-get-Blocks
                       (cdr (assoc 2 (entget dim)))
             ) ;_ end of vla-item
     (if (vlax-property-available-p item 'Textstring)
          (setq str (vla-get-textstring item))
       )
     )
(mip_MTEXT_Unformat str)
  )
(defun mip_MTEXT_Unformat ( Mtext / text Str )
  ;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=44&TID=20992
  (setq Text "")
;;;  (if (wcmatch (strcase Mtext) "\\PI-#*,\\PT*") ;;_список
;;;    (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
	   (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 8)) "\\FSYMBOL") ;;;Add VVA remove Symbol
            (setq Mtext (substr Mtext (+ 2 (cond ((vl-string-search "}" Mtext))((vl-string-search ";" Mtext)))))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
	  ((wcmatch (strcase Mtext) "\\PI-#*,\\PT*")           ;;;VVA 2011-01-20
	   (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
	  ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PTZ")  ;;;Add by KPblC
	   (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
	   )
          ((wcmatch (strcase (substr mtext 1 3)) "\\PX")  ;;;абзац и междустрочный интервал \\PX[QITSBA]
	   (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
	   )
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or
		   (zerop (strlen Text))
		   (= " " (substr Text (strlen Text)))
		   (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
	  ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
          
	  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
  Text)

[arturbd]

Сообщение от maks-ufa А если тупо скопировать чертеж рядом, разбить его, взять размеры...?

вариант простой и надежный, но все же процесс длинный.


VVA
Спасибо. просто и гениально. Поставил команду под клавишу. Быстро и приятно.
Теперь уже хочется чуть больше. Чтобы вставка из буфера была такой же как в G-Tools "изменение текста по шаблону". Т.е. просто клик на имеющися текст и он уже равен содержимому буфера обмена. Возможно ли это? Или это уже наглая фантастика


Vova
Спасибо. за ссылку (((Программа копирует текст из: DText, MText, Таблиц, Размер, Атрибуты, Определения Атрибутов, DText и MText в составе блоков вText, MText, Таблицы, Размеры, Атрибуты, Определения Атрибутов.))) вещь полезная - буду разбираться

[VVA]

Сообщение от arturbd Теперь уже хочется чуть больше. Чтобы вставка из буфера была такой же как в G-Tools "изменение текста по шаблону".

2 команды
CTRLV - вставляет текст из буфера. Текст на курсоре
TVFC - меняет содержимое текста, мтекста, атрибута, размера, ячейки таблицы на содержимое буфера обмена. (clipborad)

Код:

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

(defun C:CTRLV ( / tmp txt )
  ;;; Paste from ClipBoard. Like CTRL+V
    (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")));_Высота текста
  (if (setq tmp (Getclipboard))
    (progn
      (setq txt (entmakex
      (list
        (cons 0 "TEXT")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbText")
        (cons 72 0)           ;_ выравнивание влево
        (cons 1 tmp)
        ;(cons 7 style) ;_Текущий стиль
        ;(cons 8 layer) ;_Текущий слой
        (cons 10 '(0 0 0))
        (cons 11 '(0 0 0))
        (cons 40 *TEXTSIZE*) ;_Высота текста
        ) ;_ list
      ) ;_ entmakex
          )
  ;_ Копируем в буфер и обратно
  (princ "\n Укажите точку вставки текста: ")
  (vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
      )
    )
  )
(defun C:TVFC ( )
  ;;;TVFC- Text Value From Clipboard
  (defun TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nPaste text <exit> >>"))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
  (if (setq tmp (Getclipboard))(TTC_Paste tmp nil))
)  


;  ! ***************************************************************************
;; !                           Getclipboard
;; ! ***************************************************************************
;; ! Function : Return text string from clipboard
;; ! Argument : nil
;; ! Returns  : string
;; see http://www.theswamp.org/index.php?topic=21764.new
;; ! ****************************************************************************

(defun Getclipboard ( / htmlfile result)
;;(Getclipboard)
(setq result
        (vlax-invoke
            (vlax-get
                (vlax-get
                    (setq htmlfile (vlax-create-object "htmlfile"))
                   'ParentWindow
                )
               'ClipBoardData
            )
           'GetData
            "Text"
        )
    )
    (vlax-release-object htmlfile)
    result
)

[arturbd]

VVA !!!
Здорово! все работает. Огромное спасибо.

И хоть не по теме: можно ли в автокаде делать развертку труб. Скажем одна труба подходит к другой под углом. И для нее надо сделать развертку из бумаги, чтобы наложить на трубу и вырезать по контуру.