AutoCAD / Map 3D将当前测量值放入文本覆盖中

时间:2016-07-26 21:44:13

标签: autocad

我正在使用不精确的绘图在地图3d中工作。我有dwg尺寸我可以与图纸重叠。我需要对齐这些维度,但我不想在拉伸它之后每次输入值。有没有办法确定测量值不改变? enter image description here

2 个答案:

答案 0 :(得分:1)

我不相信这与编程有关,但你可以在AutoCAD上override dimension values

您可以尝试in VB

Sub OverrideDimensionText()
Dim dimObj As AcadDimAligned
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
Dim location(0 To 2) As Double

' Define the dimension
point1(0) = 5#: point1(1) = 3#: point1(2) = 0#
point2(0) = 10#: point2(1) = 3#: point2(2) = 0#
location(0) = 7.5: location(1) = 5#: location(2) = 0#

' Create an aligned dimension object in model space
Set dimObj = ThisDrawing.ModelSpace. _
                 AddDimAligned(point1, point2, location)

' Change the text string for the dimension
dimObj.TextOverride = "The value is <>"
dimObj.Update
End Sub

答案 1 :(得分:0)

更新: 我最后一句话错了,但这是解决方案: http://www.cadtutor.net/forum/archive/index.php/t-31690.html VVA最终获得了lisp代码。使用命令DIMO,它将覆盖文本。

;;Dim override
(defun c:dimo (/ COPYDIM CURLAY DELSET DIMLST
DIMSET ERRCOUNT LAYCOL LENT
NEXTENT OVTEXT *ERROR* ACTDOC
OLDECHO)
;;; Vladimir Smirnov {Smirnoff} on dwg.ru
(defun *ERROR* (msg)
(setvar "CMDECHO" oldEcho)
); end of error
(vl-load-com)
(setq oldEcho(getvar "CMDECHO")
actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
layCol(vla-get-Layers actDoc)
); end setq
(setvar "CMDECHO" 0)
(if
(setq dimSet
(ssget "_:L" '((0 . "DIMENSION"))))
(progn
(setq dimLst
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex dimSet))))
); end setq
(vla-StartUndoMark actDoc)
(foreach dim dimLst
(vla-put-TextOverride dim (dim-get-text-string (vlax-vla-object->ename dim)))
(vla-put-Color dim 22)
)
(vla-EndUndoMark actDoc)
); end progn
); end if
(setvar "CMDECHO" oldEcho)
(princ)
); end of c:dimo

(defun Col_Item_Find (Collection Item / result)
(if
(not
(vl-catch-all-error-p
(setq result
(vl-catch-all-apply 'vla-item
(list Collection Item)))))
result
); end if
); end of Col_Item_Find
;;; Dim restore
(defun c:dimr (/ COPYDIM CURLAY DELSET DIMLST
DIMSET ERRCOUNT LAYCOL LENT
NEXTENT OVTEXT *ERROR* ACTDOC
OLDECHO)
;;; Vladimir Smirnov {Smirnoff} on dwg.ru
(defun *ERROR* (msg)
(setvar "CMDECHO" oldEcho)
); end of error

(vl-load-com)
(setq oldEcho(getvar "CMDECHO")
actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
layCol(vla-get-Layers actDoc)
); end setq
(setvar "CMDECHO" 0)
(if
(setq dimSet
(ssget '((0 . "DIMENSION"))))
(progn
(setq dimLst
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex dimSet))))
errCount 0
); end setq
(vla-StartUndoMark actDoc)
(foreach dim dimLst
(setq curLay(vla-get-Layer dim))
(if
(/= :vlax-true
(vla-get-Lock(Col_Item_Find layCol curLay)))
(progn
(vla-put-TextOverride dim "<>")
(vla-put-Color dim 82)
); end progn
(setq errCount(1+ errCount))
); end if
); end foreach
(if(/= 0 errCount)
(princ
(strcat "\n"
(itoa errCount)" were on locked layer!"))
); end if
(vla-EndUndoMark actDoc)
); end progn
); end if
(setvar "CMDECHO" oldEcho)
(princ)
)
(defun mip_MTEXT_Unformat ( Mtext / text Str )
(setq MM Mtext)
(setq Text "")
(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 2)) "\\[ACFHQTW]")
(setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PXQ") ;;;Add by KPblC
(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)
(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)
)
(princ "\nType Dimo to override and Dimr to restore")