Đến nội dung


Hình ảnh
- - - - -

Liên kết với CAD từ Excel


  • Please log in to reply
12 replies to this topic

#1 nkgedadknr

nkgedadknr

    biết vẽ line

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

Đã gửi 12 December 2009 - 12:33 PM



Chào các bạn!

Mình đang có vấn đề này nhờ các Bạn giúp:

Mình đang thực hiện lấy các properties của Polyline từ Cad qua Excel bằng cách viết:

1. Macro Capture (Right click Popup Menu từ Excel > Capture) để chọn Polyline từ Acad. Import các properties cần thiết sang Excel.

Sau đó mình muốn Highlight polyline có propertities tại dòng n cùa màn hình Excel trên màn hình Acad và zoom tới vị trí Polyline đó bằng Zoom Center: giải thuật của mình là chọn tất cả entities của bản vẽ hiện tại, chọn entity nào có handle cùng với handle trên Excel thì highllight và zoom tới entity đó

2. Macro Highlight (Right click Popup Menu từ Excel > Hightlight)

Mình có attach thêm 1 bản vẽ Cad và 1 workbook Excel

Đối với những Polyline mình tạo ra thì macro Highlight thực thi OK: nghĩ là highlight polyline và zoom tới vị trí đó. (trên bản vẽ là layer 0)

Tuy nhiên, với những polyline mà mình có sẳn (layer 1) thì macro Highlight không thực hiện được.

Mình thấy hiện tượng như vậy. Vì trong Code của Macro Highlight mình Debug.Print tọa độ của objEnt.Coordinates thì thấy trong trường hợp layer 1 Coordinate này bằng 0 (không nhận được). Trong khi layer 0 thì objEnt.Coordinate hiểu được.

Các Bạn giúp mình một tay nhé. Tiện đây nhờ các bác đóng góp ý kiến cho giải thuật zoom lấy entity để highlight và Code của mình thêm hoàn thiện.
À mà mình muốn highlight entity có hiển thị các grid mày xanh ở 2 đầu và cuối polyline đó thì làm sao nhỉ

http://www.cadviet.c.../upkc121209.rar
  • 0

#2 nkgedadknr

nkgedadknr

    biết vẽ line

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

Đã gửi 18 December 2009 - 02:45 PM

Mình chạy mã này trên màn hình Excel (từ ribbon)
Mình muốn set focus back to Excel screen(select some cells) sau khi hide entity in Cad screen, những mã này chạy không theo ý mình, xin các Bạn giúp mình với.

Vấn đề trên mình đã solve được rồi


Private Sub UnHide(control As IRibbonControl)
Dim objApp As Object
Dim ExcCap As String
ExcCap = Application.Caption

On Error Resume Next
Set objApp = GetObject(, "AutoCAD.Application")
Dim objDoc As AcadDocument
AppActivate "AutoCAD", True
With objApp
Set objDoc = .ActiveDocument
Dim objEnt As AcadEntity
For Each objEnt In objDoc.ModelSpace
objEnt.Visible = True
Next objEnt
objDoc.Regen acAllViewports
End With
AppActivate objApp, False
Set objDoc = Nothing
Set objApp = Nothing

AppActivate ExcCap, True
End Sub
  • 0

#3 nkgedadknr

nkgedadknr

    biết vẽ line

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

Đã gửi 20 December 2009 - 08:58 PM

Nhờ các bác cao thủ giúp Em với. Em bí cái này mãi mà không được
  • 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 20 December 2009 - 09:24 PM

Nhưng tới cuối cùng vẫn không biết bạn bí cái gì.
Bạn ra câu hỏi sau đó nói là giải quyết được rồi mà.
  • 0
Clear sky!

MF Rock collection.

#5 nkgedadknr

nkgedadknr

    biết vẽ line

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

Đã gửi 21 December 2009 - 08:38 AM

Nhưng tới cuối cùng vẫn không biết bạn bí cái gì.
Bạn ra câu hỏi sau đó nói là giải quyết được rồi mà.


Em bí cái này ạ:
Em không thể quay về màn hình Excel (activate) bằng appactivate sao khi thao tác trên Cad. Cursor vẫn hiện trên Cad
http://www.cadviet.c...tfocusexcel.jpg

[code]
Private Sub UnHide(control As IRibbonControl)
Dim objApp As Object
Dim ExcCap As String
ExcCap = Application.Caption

On Error Resume Next
Set objApp = GetObject(, "AutoCAD.Application")
Dim objDoc As AcadDocument
AppActivate "AutoCAD", True
With objApp
Set objDoc = .ActiveDocument
Dim objEnt As AcadEntity
For Each objEnt In objDoc.ModelSpace
objEnt.Visible = True
Next objEnt
objDoc.Regen acAllViewports
End With
AppActivate objApp, False
Set objDoc = Nothing
Set objApp = Nothing

AppActivate ExcCap, True
End Sub
[code/]
  • 0

#6 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 21 December 2009 - 02:08 PM

Em bí cái này ạ:
Em không thể quay về màn hình Excel (activate) bằng appactivate sao khi thao tác trên Cad. Cursor vẫn hiện trên Cad
http://www.cadviet.c...tfocusexcel.jpg

[code]
Private Sub UnHide(control As IRibbonControl)
Dim objApp As Object
Dim ExcCap As String
ExcCap = Application.Caption

On Error Resume Next
Set objApp = GetObject(, "AutoCAD.Application")
Dim objDoc As AcadDocument
AppActivate "AutoCAD", True
With objApp
Set objDoc = .ActiveDocument
Dim objEnt As AcadEntity
For Each objEnt In objDoc.ModelSpace
objEnt.Visible = True
Next objEnt
objDoc.Regen acAllViewports
End With
AppActivate objApp, False
Set objDoc = Nothing
Set objApp = Nothing

AppActivate ExcCap, True
End Sub
[code/]


Bạn dùng biến ExcelObj đại diện cho Excel, AcadApp đại diện cho Acad

Bạn cần thiết lập liên kết tương ứng
Set ExcelObj = GetObject(, "Excel.Application")

Set AcadObj = GetObject(, "ACAD.Application")

Sau đó muốn activate thằng nào thì dùng hàm sau
AppActivate AppObj.Caption

Trong đó AppObj là biến liên kết với chương trình Excel, ACAD hay Word hay bất kỳ chương trình nào có thông qua quá trình cài đặt trên PC.

Caption là biến đại diện cho tiêu đề của cửa sổ chương trình đang liên kết. Caption sử dụng để tương thích ngược.
  • 1
Clear sky!

MF Rock collection.

#7 nkgedadknr

nkgedadknr

    biết vẽ line

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

Đã gửi 21 December 2009 - 03:04 PM

Bạn dùng biến ExcelObj đại diện cho Excel, AcadApp đại diện cho Acad

Bạn cần thiết lập liên kết tương ứng
Set ExcelObj = GetObject(, "Excel.Application")

Set AcadObj = GetObject(, "ACAD.Application")

Sau đó muốn activate thằng nào thì dùng hàm sau
AppActivate AppObj.Caption

Trong đó AppObj là biến liên kết với chương trình Excel, ACAD hay Word hay bất kỳ chương trình nào có thông qua quá trình cài đặt trên PC.

Caption là biến đại diện cho tiêu đề của cửa sổ chương trình đang liên kết. Caption sử dụng để tương thích ngược.



Cảm ơn Bạn.

Mình đã đặt lại tên Application theo như ý Bạn. Tuy nhiên khi chuyển qua Appactivate EXCELApp.Caption thì cursor vẫn hiển thị trên màn hình CAD, mình phải di chuyển qua màn hình Excel và Click thì mới Activate được Excel
  • 0

#8 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 21 December 2009 - 08:24 PM

Ví dụ đơn giản về active Excel:
Trong trường hợp Excel đã khởi động, hàm sau làm việc tốt

Sub test()
Dim ExcelObj As Object
Set ExcelObj = GetObject(, "Excel.Application")
AppActivate ExcelObj.Caption
Set ExcelObj = Nothing
End Sub

Hàm GetObject sẽ liên kết với đối tượng có cùng class và được khởi động đầu tiên nhất.
Trong trường hợp của bạn có thể hàm GetObject đã liên kết với một bản Excel đang chạy ở background.
Bạn kiểm tra trong Task Manager xem có một bản Excel nào đang chạy không.
Để chắc ăn hơn, kèm theo lệnh sau:

Set ExcelObj = GetObject(, "Excel.Application")
Excel.Visible = True
Sẽ làm cho bản Excel đang chạy ở background trở thành foreground
  • 0
Clear sky!

MF Rock collection.

#9 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 21 December 2009 - 09:51 PM

Tớ có mấy cái tiện ích, hôm nào đem ra cho mọi người xài.
  • 2
Clear sky!

MF Rock collection.

#10 nkgedadknr

nkgedadknr

    biết vẽ line

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

Đã gửi 21 December 2009 - 10:18 PM

Tớ có mấy cái tiện ích, hôm nào đem ra cho mọi người xài.


Bác thật chính xác như thần, không biết tại sao Em mở Tasl Manager lên lại có 2 Excel, vậy là thế nào hở bác, Em xài Excel 2007, kết hợp với cad 2010.
Lúc trước em chạy macro xuất từ cad sang excel thì cũng gặp th này 2 excel chạy song song nhưng em ko quan tâm
nhưng giờ em chạy từ excel sang cad thì vâp phải cái này. Xin cao kiến Bác???
Mai Em lên VP up cái hình đó cho Bác xem ạ
Em có nhu cầu viết tiện ích vba, chắc hôm nào xin bác chút thời gian được không ạ? E ở SG
  • 0

#11 KVT

KVT

    Chưa sử dụng CAD

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

Đã gửi 04 January 2010 - 11:07 AM

Bác thật chính xác như thần, không biết tại sao Em mở Tasl Manager lên lại có 2 Excel, vậy là thế nào hở bác, Em xài Excel 2007, kết hợp với cad 2010.
Lúc trước em chạy macro xuất từ cad sang excel thì cũng gặp th này 2 excel chạy song song nhưng em ko quan tâm
nhưng giờ em chạy từ excel sang cad thì vâp phải cái này. Xin cao kiến Bác???
Mai Em lên VP up cái hình đó cho Bác xem ạ
Em có nhu cầu viết tiện ích vba, chắc hôm nào xin bác chút thời gian được không ạ? E ở SG


Bạn thử đưa đoạn mã đó lên để mọi người xem thử.
  • 0

#12 phantuhuong

phantuhuong

    biết dimstyle

  • Moderator
  • PipPipPipPipPip
  • 383 Bài viết
Điểm đánh giá: 200 (khá)

Đã gửi 08 January 2010 - 10:59 AM

Bác thật chính xác như thần, không biết tại sao Em mở Tasl Manager lên lại có 2 Excel

oo

Lỗi của chương trình là dùng CreateObject để mở Excel. Phải dùng GetObject trước vì trong trường hợp Excel đã mở thì nó sẽ không mở thêm.

Code để tham khảo đây:

Sub KhoidongExcel()
On Error Resume Next 'Bo qua loi khi Excel chua mo
'Khi Excel dang mo
Set ExcelApp = GetObject(, "Excel.Application")
'Khi Excel chua mo thi mo r
If Err Then
Err.Clear
Set ExcelApp = CreateObject("Excel.Application")
End If

ExcelApp.Visible = True
AppActivate AutoCAD.Caption
Set ExcelApp =NOTHING
End Sub

  • 0
Bồi dưỡng Excel & VBA cho các đơn vị ở Hà Nội và khu vực lân cận

Từng bước loại đồ Tàu ra khỏi cuộc sống!


#13 CDung_k47

CDung_k47

    biết vẽ pline

  • Members
  • PipPip
  • 65 Bài viết
Điểm đánh giá: 36 (tàm tạm)

Đã gửi 08 January 2010 - 02:29 PM

Bác Phantuhuong cho em hỏi chút,đây là đoạn code tạo Hatch bằng VBA em tìm được trên google tác giả là bác post lên,đoạn code này tạo Hatch cho nửa đường tròn.Em thực hành tạo Hatch cho 1 vùng khác nhưng làm mãi không được,kiến thức còn hạn hẹp,mong bác và các cao thủ trong diễn đàn chỉ giùm.
Sub Example_AppendInnerLoop()
' This example creates an associative hatch in model space.

Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
Dim DiemP(0 To 2) As Double

' Define the hatch
patternName = "ANSI31"
PatternType = 0
bAssociativity = True

' Create the associative Hatch object
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)

' Create the outer loop for the hatch.
' An arc and a line are used to create a closed loop.

Dim outerLoop(0 To 1) As AcadEntity
Dim center(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
center(0) = 5: center(1) = 3: center(2) = 0
DiemP(0) = 2.5: DiemP(1) = 3.5
radius = 3
startAngle = 0
endAngle = 3.141592
Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).StartPoint, outerLoop(0).EndPoint)

' Append the outer loop to the hatch object
hatchObj.AppendOuterLoop (outerLoop)

' Append a circle as the inner loop for the hatch.
Dim innerLoop(0) As AcadEntity
Dim innerLoop1(0) As AcadEntity
center(0) = 5: center(1) = 4.5: center(2) = 0
radius = 1
Set innerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
Set innerLoop1(0) = ThisDrawing.ModelSpace.AddText("PTH", DiemP, 0.2)
hatchObj.AppendInnerLoop (innerLoop)
hatchObj.AppendInnerLoop (innerLoop1)

' Evaluate and display the hatch
hatchObj.Evaluate
ThisDrawing.Regen True

End Sub

  • 0