更改多维度mea

apsonwane · 发表于 2022-7-6 09:23:48

是否可以在一个命令中将多个维度中的测量文本更改为正常文本，以便在缩放或拉伸对象时，维度文本值不再更改？

简而言之，我想把尺寸转换成数字文本。

提前感谢，

阿什语

Tharwat · 发表于 2022-7-6 09:30:59

看看这个。


(defun c:Test (/ ss str)
 (if
   (and
     (setq str (getstring T "\n Enter Text:"))
     (setq ss (ssget "_:L" '((0 . "*DIMENSION"))))
   )
    (command "_.DimEdit" "_New" str ss "")
 )
 (princ)
)

塔瓦特

Tiger · 发表于 2022-7-6 09:33:55

你可以*颤抖**喘息**吞咽*爆炸维度。。。。

Lee Mac · 发表于 2022-7-6 09:40:22

我不明白你为什么要做这样的事？

这将完成任务。。。

copy

(defun c:test ( / ss i e )
 (if (setq ss (ssget "_:L" '((0 . "*DIMENSION"))))
   (repeat (setq i (sslength ss))
     (entupd
       (cdr
         (assoc -1
           (entmod
             (subst
               (cons 1
                 (LM:GetDimensionString (setq e (ssname ss (setq i (1- i)))))
               )
               (assoc 1 (setq e (entget e))) e
             )
           )
         )
       )
     )
   )
 )
 (princ)
)
(defun LM:GetDimensionString ( dim / dl db ds )
 (if
   (and
     (wcmatch (cdr (assoc 0 (setq dl (entget dim)))) "*DIMENSION")
     (setq db (tblobjname "BLOCK" (cdr (assoc 2 dl))))
   )
   (while (and (setq db (entnext db)) (not ds))
     (if (eq "MTEXT" (cdr (assoc 0 (setq dl (entget db)))))
       (setq ds (cdr (assoc 1 dl)))
     )
   )
 )
 ds
)

dbroada · 发表于 2022-7-6 09:48:17

我本打算提出这个建议，但我决定不想让主持人责备我。

apsonwane · 发表于 2022-7-6 09:49:39

再次感谢勒麦克。
这正是我想要的。
我需要这样做的原因是，我总是需要在同一张纸上放大绘图的某些部分，在那里我缩放该部分，保持相同的尺寸值。

干杯
阿什语

ReMark · 发表于 2022-7-6 09:55:15

这就是为什么引入图纸空间布局和“注释性缩放”的原因，这样您就不必经历这些。你为什么不利用2010年内置的功能？您也可以使用AutoCAD release 9。

pBe · 发表于 2022-7-6 09:58:53

copy

(defun c:test  (/ selset Units DimValue DimValue DimPrec)
     (vl-load-com)
     (if (ssget '((0 . "DIMENSION")))
           (progn
                 (vlax-for
                        Text  (setq selset
                                         (vla-get-activeselectionset
                                               (vla-get-activedocument
                                                     (vlax-get-acad-object))))
                       (setq Units (vla-get-UnitsFormat text)
                             DimValue (vla-get-measurement text)
                                  DimPrec  (vla-get-PrimaryUnitsPrecision
                                               text)
                             )
                       (vla-put-TextOverride
                             text
                             (if (or (= Units 3)
                                     (= Units 4))
                                   (rtos DimValue
                                         4
                                         DimPrec)
                                   (rtos DimValue
                                         2
                                         DimPrec)
                                   )
                             )
                       )
                 (vla-delete selset)
                 )
           )
     )