VB如何将EXCEL中指定的几行表格粘贴至CAD文件中指定的框框内?
请各位大师指导:VB如何将EXCEL中指定的几行表格粘贴至CAD文件中指定的红色框框内?
粘贴后的效果见附件。
Drawing1.rar
(13.64 KB)
Dim EXAPP As Excel.Application Dim WB As Excel.Workbook Dim sht As Excel.Worksheet Dim AApp As AcadApplication Dim ADWG As AcadDocument Private Sub Form_Load() Set EXAPP = CreateObject("excel.application") Set WB = EXAPP.Workbooks.Open("c:\test.xlsx") Set sht = WB.Worksheets("Sheet1") Set AApp = CreateObject("Autocad.Application") Set ADWG = AApp.documents.Open("c:\drawing1.dwg") Range("h7", "m9").Select Range("h7", "m9").Copy ADWG.SendCommand "_pasteclip" & vbCr & "0,0" & vbCr ADWG.Save Form1.Caption = "OK" End Sub Private Sub Form_Unload(Cancel As Integer) ADWG.Close Set ADWG = Nothing Set AApp = Nothing WB.Close Set sht = Nothing Set WB = Nothing Set EXAPP = Nothing End Sub可以实现选择excel文件指定区域并复制到剪贴板,再粘贴到CAD文件指定位置。
Dim ADWG As AcadDocument Dim i As Long Dim parameter As Variant Dim CoordString As String Private Sub Form_Load() Me.Show Set EXAPP = CreateObject("excel.application") Set WB = EXAPP.Workbooks.Open("c:\test.xls") Set sht = WB.Worksheets("Sheet1") Set AApp = CreateObject("Autocad.Application") Set ADWG = AApp.documents.Open("c:\drawing1.dwg") Range("h7", "m9").Select Range("h7", "m9").Copy For i = 0 To AApp.ActiveDocument.ModelSpace.Count - 1 If AApp.ActiveDocument.ModelSpace(i).Lineweight = 106 Then parameter = AApp.ActiveDocument.ModelSpace(i).Coordinates Exit For End If Next CoordString = parameter(0) & "," & parameter(1) ADWG.SendCommand "_pasteclip" & vbCr & CoordString & vbCr ADWG.Save Form1.Caption = "OK" End Sub Private Sub Form_Unload(Cancel As Integer) ADWG.Close Set ADWG = Nothing AApp.Quit Set AApp = Nothing WB.Close Set sht = Nothing Set WB = Nothing Set EXAPP = Nothing End Sub缩放至同样大小进一步深化。方向都明确了,自己也多查资料。