浩辰cad表格怎么导到excel
发布网友
发布时间：2022-04-26 03:14
共5个回答
热心网友
时间：2022-05-11 10:57
导出方法如下：
点击浩辰CAD扩展工具中的“CAD表格转Excel”命令图标；
命令运行后会弹出一个“转换尺寸比例”的对话框；
在对话框中，用户可以选择转换表格之间的尺寸比例，这一参数会直接影响生成表格的尺寸大小。
按系统提示框选建筑明面积细表，并确定，软件会自动将CAD表格转换为Excel并将其打开。建筑面积明细表转换效果，如下图。
从转换效果上看，转换后的Excel表格不仅数据准确，而且格式美观大方，用户可以直接使用该表格进行修改、添加、删除、打印……省去了许多表格调整工作的烦恼。
热心网友
时间：2022-05-11 12:15
浩辰CAD表格导入excel的操作步骤
首先使用浩辰CAD软件打开图纸，然后用鼠标框选BOM表，在菜单栏中找到并点击【扩展工具】——在下拉框中找到【表格工具】——选择并点击【CAD表格转换EXCEL】，在弹出对话框中确定好大小比例，CAD软件将会自动输出EXCEL表格。如下图所示：
以上就是浩辰CAD软件中将CAD表格导入到excel的详细操作步骤。
热心网友
时间：2022-05-11 13:50
我电脑没装cad，不然可以模拟做一个例子了。
不过，这里有一个程序，是excel到CAD的，可以参考一下。
Sub 根据excel自动画表()
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
Dim xlSheet As Worksheet
Set xlSheet = xlApp.ActiveSheet
Dim iPt(0 To 2) As Double
iPt(0) = 0: iPt(1) = 0: iPt(2) = 0
Dim BlockObj As AcadBlock
Set BlockObj = ThisDrawing.Blocks("*Model_Space")
Dim xlRange As Range
For Each xlRange In xlSheet.UsedRange
AddLine BlockObj, xlRange
AddText BlockObj, xlRange
Next
Set xlRange = Nothing
Set xlSheet = Nothing
Set xlApp = Nothing
End Sub
'边框处理
Sub AddLine(ByRef BlockObj As AcadBlock, ByVal xlRange As Range)
Dim rl As Double
Dim rt As Double
Dim rw As Double
Dim rh As Double
rl = xlRange.Left / 2.835
rt = xlRange.top / 2.835
rw = xlRange.Width / 2.835
rh = xlRange.Height / 2.835
Dim pPt(0 To 3) As Double
Dim pLineObj As AcadLWPolyline
If xlRange.Borders(xlEdgeLeft).LineStyle <> xlNone And xlRange.Column = 1 Then
pPt(0) = rl: pPt(1) = -rt
pPt(2) = rl: pPt(3) = -(rl + rh)
Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)
With xlRange.Borders(xlEdgeLeft)
If .ColorIndex <> xlAutomatic Then
If .ColorIndex = 3 Then
pLineObj.color = acRed
ElseIf .ColorIndex = 4 Then
pLineObj.color = acGreen
ElseIf .ColorIndex = 5 Then
pLineObj.color = acBlue
ElseIf .ColorIndex = 6 Then
pLineObj.color = acYellow
ElseIf .ColorIndex = 8 Then
pLineObj.color = acCyan
ElseIf .ColorIndex = 9 Then
pLineObj.color = acMagenta
End If
End If
If .Weight = xlThin Then
pLineObj.ConstantWidth = 0
ElseIf .Weight = xlMedium Then
pLineObj.ConstantWidth = 0.35
ElseIf .Weight = xlThick Then
pLineObj.ConstantWidth = 0.7
End If
End With
End If
If xlRange.Borders(xlEdgeBottom).LineStyle <> xlNone And (xlRange.Row = xlRange.MergeArea.Row + xlRange.MergeArea.Rows.Count - 1) Then
pPt(0) = rl: pPt(1) = -(rt + rh)
pPt(2) = rl + rw: pPt(3) = -(rt + rh)
Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)
With xlRange.Borders(xlEdgeBottom)
If .ColorIndex <> xlAutomatic Then
If .ColorIndex = 3 Then
pLineObj.color = acRed
ElseIf .ColorIndex = 4 Then
pLineObj.color = acGreen
ElseIf .ColorIndex = 5 Then
pLineObj.color = acBlue
ElseIf .ColorIndex = 6 Then
pLineObj.color = acYellow
ElseIf .ColorIndex = 8 Then
pLineObj.color = acCyan
ElseIf .ColorIndex = 9 Then
pLineObj.color = acMagenta
End If
End If
If .Weight = xlThin Then
pLineObj.ConstantWidth = 0
ElseIf .Weight = xlMedium Then
pLineObj.ConstantWidth = 0.35
ElseIf .Weight = xlThick Then
pLineObj.ConstantWidth = 0.7
End If
End With
End If
If xlRange.Borders(xlEdgeRight).LineStyle <> xlNone And (xlRange.Column >= xlRange.MergeArea.Column + xlRange.MergeArea.Columns.Count - 1) Then
pPt(0) = rl + rw: pPt(1) = -(rt + rh)
pPt(2) = rl + rw: pPt(3) = -rt
Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)
With xlRange.Borders(xlEdgeRight)
If .ColorIndex <> xlAutomatic Then
If .ColorIndex = 3 Then
pLineObj.color = acRed
ElseIf .ColorIndex = 4 Then
pLineObj.color = acGreen
ElseIf .ColorIndex = 5 Then
pLineObj.color = acBlue
ElseIf .ColorIndex = 6 Then
pLineObj.color = acYellow
ElseIf .ColorIndex = 8 Then
pLineObj.color = acCyan
ElseIf .ColorIndex = 9 Then
pLineObj.color = acMagenta
End If
End If
If .Weight = xlThin Then
pLineObj.ConstantWidth = 0
ElseIf .Weight = xlMedium Then
pLineObj.ConstantWidth = 0.35
ElseIf .Weight = xlThick Then
pLineObj.ConstantWidth = 0.7
End If
End With
End If
If xlRange.Borders(xlEdgeTop).LineStyle <> xlNone And xlRange.top = 1 Then
pPt(0) = rl + rw: pPt(1) = -rt
pPt(2) = rl: pPt(3) = -rt
Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)
With xlRange.Borders(xlEdgeTop)
If .ColorIndex <> xlAutomatic Then
If .ColorIndex = 3 Then
pLineObj.color = acRed
ElseIf .ColorIndex = 4 Then
pLineObj.color = acGreen
ElseIf .ColorIndex = 5 Then
pLineObj.color = acBlue
ElseIf .ColorIndex = 6 Then
pLineObj.color = acYellow
ElseIf .ColorIndex = 8 Then
pLineObj.color = acCyan
ElseIf .ColorIndex = 9 Then
pLineObj.color = acMagenta
End If
End If
If .Weight = xlThin Then
pLineObj.ConstantWidth = 0
ElseIf .Weight = xlMedium Then
pLineObj.ConstantWidth = 0.35
ElseIf .Weight = xlThick Then
pLineObj.ConstantWidth = 0.7
End If
End With
End If
Set pLineObj = Nothing
End Sub
'文字处理
Sub AddText(ByRef BlockObj As AcadBlock, ByVal xlRange As Range)
If xlRange.Text = "" Then Exit Sub
Dim rl As Double
Dim rt As Double
Dim rw As Double
Dim rh As Double
rl = xlRange.Left / 2.835
rt = xlRange.top / 2.835
rw = xlRange.MergeArea.Width / 2.835
rh = xlRange.MergeArea.Height / 2.835
Dim iPt(0 To 2) As Double
iPt(0) = rl: iPt(1) = -rt: iPt(2) = 0
Dim mTextObj As AcadMText
Set mTextObj = BlockObj.AddMText(iPt, rw, xlRange.Text)
Dim tPt As Variant
If xlRange.VerticalAlignment = xlTop And (xlRange.HorizontalAlignment = xlLeft Or xlRange.HorizontalAlignment = xlGeneral) Then
mTextObj.AttachmentPoint = acAttachmentPointTopLeft
mTextObj.InsertionPoint = iPt
ElseIf xlRange.VerticalAlignment = xlTop And xlRange.HorizontalAlignment = xlCenter Then
mTextObj.AttachmentPoint = acAttachmentPointTopCenter
tPt = ThisDrawing.Utility.PolarPoint(iPt, 0, rw / 2)
ElseIf xlRange.VerticalAlignment = xlTop And xlRange.HorizontalAlignment = xlRight Then
mTextObj.AttachmentPoint = acAttachmentPointTopRight
tPt = ThisDrawing.Utility.PolarPoint(iPt, 0, rw)
ElseIf xlRange.VerticalAlignment = xlCenter And (xlRange.HorizontalAlignment = xlLeft _
Or xlRange.HorizontalAlignment = xlGeneral) Then
mTextObj.AttachmentPoint = acAttachmentPointMiddleLeft
tPt = ThisDrawing.Utility.PolarPoint(iPt, -1.5707963, rh / 2)
ElseIf xlRange.VerticalAlignment = xlCenter And xlRange.HorizontalAlignment = xlCenter Then
mTextObj.AttachmentPoint = acAttachmentPointMiddleCenter
tPt = ThisDrawing.Utility.PolarPoint(iPt, -1.5707963, rh / 2)
tPt = ThisDrawing.Utility.PolarPoint(tPt, 0, rw / 2)
ElseIf xlRange.VerticalAlignment = xlCenter And xlRange.HorizontalAlignment = xlRight Then
mTextObj.AttachmentPoint = acAttachmentPointMiddleRight
tPt = ThisDrawing.Utility.PolarPoint(iPt, -1.5707963, rh / 2)
tPt = ThisDrawing.Utility.PolarPoint(tPt, 0, rw / 2)
ElseIf xlRange.VerticalAlignment = xlBottom And (xlRange.HorizontalAlignment = xlLeft _
Or xlRange.HorizontalAlignment = xlGeneral) Then
mTextObj.AttachmentPoint = acAttachmentPointBottomLeft
tPt = ThisDrawing.Utility.PolarPoint(iPt, -1.5707963, rh)
ElseIf xlRange.VerticalAlignment = xlBottom And xlRange.HorizontalAlignment = xlCenter Then
mTextObj.AttachmentPoint = acAttachmentPointBottomCenter
tPt = ThisDrawing.Utility.PolarPoint(iPt, -1.5707963, rh)
tPt = ThisDrawing.Utility.PolarPoint(tPt, 0, rw / 2)
ElseIf xlRange.VerticalAlignment = xlBottom And xlRange.HorizontalAlignment = xlRight Then
mTextObj.AttachmentPoint = acAttachmentPointBottomRight
tPt = ThisDrawing.Utility.PolarPoint(iPt, -1.5707963, rh)
tPt = ThisDrawing.Utility.PolarPoint(tPt, 0, rw)
End If
mTextObj.InsertionPoint = tPt
Set mTextObj = Nothing
End Sub
注：该程序来自VBA二次开发CAD技术
热心网友
时间：2022-05-11 15:41
CAD迷你画图有个提取表格功能，图纸空白处右键，在表格工具里。选中你需要导出的表格，保存就可以了。
热心网友
时间：2022-05-11 17:49
