Sub CalculateAndDuplicate()
' 声明变量
Dim docName As String
Dim regex As Object
Dim match As Object
Dim length As Double
Dim width As Double
Dim height As Double
Dim symmetryDistance As Double
' 获取活动文档的文件名
docName = ActiveDocument.FullName
' 创建正则表达式对象
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "(\d+)\s*[xX×]\s*(\d+)\s*[xX×]\s*(\d+)"
regex.Global = False
' 执行匹配
Set match = regex.Execute(docName)
' 检查是否找到匹配
If match.Count > 0 Then
' 提取长、宽、高
length = CDbl(match(0).SubMatches(0))
width = CDbl(match(0).SubMatches(1))
height = CDbl(match(0).SubMatches(2))
' 计算长+宽的和(对称距离)
symmetryDistance = length + width
' 显示信息
MsgBox "长: " & length & "mm" & vbCrLf & _
"宽: " & width & "mm" & vbCrLf & _
"高: " & height & "mm" & vbCrLf & _
"对称距离: " & symmetryDistance & "mm", vbInformation, "尺寸信息"
' 复制选中的对象并移动到对称位置
If ActiveSelectionRange.Count > 0 Then
ActiveSelectionRange.Duplicate
ActiveSelectionRange.ShiftX = symmetryDistance
MsgBox "已复制到对称面,距离为 " & symmetryDistance & "mm", vbInformation, "操作完成"
Else
MsgBox "请先选择要复制的对象", vbExclamation, "操作提示"
End If
Else
MsgBox "未能从文件名中找到尺寸信息,请确保文件名包含类似'480x375x250'的格式", vbExclamation, "错误"
End If
End Sub