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

Question

我正在使用Map 3D绘制不精确的地图。我有尺寸我可以与绘图重叠的DWG。我需要对齐这些维度，但我不想在每次拉伸它后输入值。有没有办法将测量结果修改为不改变？

Answer 1

我不相信这是有关编程，但可以override dimension values AutoCAD平台。

您可以尝试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 

Answer 2

更新： 我是错的最后一条语句，但在这里是解决方案： 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")