Các cao thủ sửa giúp em đoạn code này với

[trieubb 5]

Đầu tiên là đoạn code em muốn từ Excel bấm 1 nút nó sẽ vào CAD và thực hiện luôn lệch vẽ LINE:

 

Sub Mo_AutoCad()

Dim AcaDApp As Object

On Error Resume Next

Set AcaDApp = GetObject(, "AutoCAD.Application")

If Err <> 0 Then

Err.Clear

KT = True

Set AcaDApp = CreateObject("AutoCAD.Application")

End If

AppActivate AcaDApp.Caption

AcaDApp.Visible = True

Set AcaDApp = Nothing

Set AcaDApp = ThisDrawing.Line.Add

End Sub

 

 

Đoạn này là em muốn viết cái vòng lặp nó sẽ lấy kết quả hàng 1 cột A ở Sheets1 vào hàng 1 cột A ở Sheets2, rồi hàng 2 cột A ở Sheets1

vào hàng 3 cột A ở Sheets2 ...

 

Sub Sheets2()

Sheets("Sheets2").Select

Dim i As Integer

For i = 0 To 10

Sheets2.Cells(i + 2, 1) = Sheets1.Cells(i + 1, 1)

Next

End Sub

[anhcos 196]

Đầu tiên là đoạn code em muốn từ Excel bấm 1 nút nó sẽ vào CAD và thực hiện luôn lệch vẽ LINE:

 

Sub Mo_AutoCad()

Dim AcaDApp As Object

On Error Resume Next

Set AcaDApp = GetObject(, "AutoCAD.Application")

If Err <> 0 Then

Err.Clear

KT = True

Set AcaDApp = CreateObject("AutoCAD.Application")

End If

AppActivate AcaDApp.Caption

AcaDApp.Visible = True

Set AcaDApp = Nothing

Set AcaDApp = ThisDrawing.Line.Add

End Sub

 

Thay 2 dòng màu đỏ bằng các dòng sau

Dim startPoint(0 To 2) As Double	  Dim endPoint(0 To 2) As Double  'chưa có gán giá trị cho 2 điểm này
   Dim LineObj as object
   Set LineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)

 

Đoạn này là em muốn viết cái vòng lặp nó sẽ lấy kết quả hàng 1 cột A ở Sheets1 vào hàng 1 cột A ở Sheets2, rồi hàng 2 cột A ở Sheets1

vào hàng 3 cột A ở Sheets2 ...

 

Sub Sheets2()

Sheets("Sheets2").Select

Dim i As Integer

For i = 0 To 10

Sheets2.Cells(i + 2, 1) = Sheets1.Cells(i + 1, 1)

Next

End Sub

 

Sub ChuyenDuLieu()

For i = 1 To 10

Sheets("Sheet2").Cells(i,1)=Sheets("Sheet1").Cells(i,1)

Next i

End Sub

[trieubb 5]

Thay 2 dòng màu đỏ bằng các dòng sau

Dim startPoint(0 To 2) As Double	  Dim endPoint(0 To 2) As Double  'chưa có gán giá trị cho 2 điểm này
   Dim LineObj as object
   Set LineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)

Sub ChuyenDuLieu()

For i = 1 To 10

Sheets("Sheet2").Cells(i,1)=Sheets("Sheet1").Cells(i,1)

Next i

End Sub

 

Cảm ơn bác nhưng cái vẽ LINE luôn trong CAD vẫn không thực hiện bác ạ

nó cứ đứng đực ra không chịu làm gì cả

bác giúp em cho chót đi

nếu em muốn thay lệnh Line bằng lệnh ERASE có được không

[anhcos 196]

Cảm ơn bác nhưng cái vẽ LINE luôn trong CAD vẫn không thực hiện bác ạ

nó cứ đứng đực ra không chịu làm gì cả

bác giúp em cho chót đi

nếu em muốn thay lệnh Line bằng lệnh ERASE có được không

 

Dim startPoint(0 To 2) As Double 'điểm đầu

startPoint(0)=1

startPoint(1)=2

startPoint(2)=0

 

Dim endPoint(0 To 2) As Double 'điểm cuối

endPoint(0)=3

endPoint(1)=2.2

endPoint(2)=0

 

Dim LineObj as object

 

'Vẽ đường thẳng

Set LineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)

 

'Xóa nó

LineObj.Delete