Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
3 replies to this topic

#1 trieubb

trieubb

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 30 September 2009 - 05:39 PM

Đầ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
  • 0

#2 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 30 September 2009 - 06:54 PM

Đầ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
  • 1
Clear sky!

MF Rock collection.

#3 trieubb

trieubb

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 01 October 2009 - 09:59 AM

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

  • 0

#4 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 02 October 2009 - 08:06 AM

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
  • 0
Clear sky!

MF Rock collection.