Đến nội dung


Hình ảnh
- - - - -

VBA ghi text vao giữa đoạn thẳng vừa vẽ


  • Please log in to reply
32 replies to this topic

#21 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 17 March 2016 - 03:43 PM

bạn gia_bach xem giúp mình cái file này với.

Nó toàn báo "no entity was select"

http://www.cadviet.c...t_to_line_1.rar

Thêm HideShow hộp thoại ở đầu và cuối Sub :

Private Sub CommandButton1_Click()
    UserForm1.Hide
    '................
    ThisDrawing.Regen acAllViewports
    UserForm1.show
End Sub

  • 1

#22 phuong44e1

phuong44e1

    Edu level: li4

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

Đã gửi 17 March 2016 - 05:08 PM

 

Thêm HideShow hộp thoại ở đầu và cuối Sub :

Private Sub CommandButton1_Click()
    UserForm1.Hide
    '................
    ThisDrawing.Regen acAllViewports
    UserForm1.show
End Sub

Mình đã làm dc. Cảm ơn bạn, cảm ơn diễn đàn


  • 0

#23 phuong44e1

phuong44e1

    Edu level: li4

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

Đã gửi 17 March 2016 - 11:14 PM

Mình đã làm dc. Cảm ơn bạn, cảm ơn diễn đàn

Dim objEntity As AcadEntity
    Dim varPick As Variant
    Dim lineobj As AcadLine
    Dim plineobj As AcadLWPolyline
    Dim Stapt As Variant
    Dim Midpt As Variant
    Dim Endpt As Variant
    Dim length As Double
    Dim ang As Double
    Dim txt1 As String
    Dim Index As Integer
    Dim textobj As AcadText
    ThisDrawing.Utility.GetEntity objEntity, varPick, "Select an entity"
If objEntity Is Nothing Then
    MsgBox " No entity was select"
    Exit Sub
End If
If objEntity.ObjectnName = "AcDbLine" Then
   .............
Else
If objEntity.ObjectnName = "AcDbPolyLine" Then
    Set plineobj = objEntity
    Stapt = plineobj.Coordinate(Index)
    length = plineobj.length
    txt1 = ThisDrawing.Utility.RealToString(length, 2, 2)
    Set textobj = ThisDrawing.ModelSpace.AddText(txt1, Stapt, length / 20)
Else
Exit Sub
End If
End If
ThisDrawing.Regen acAllViewports
UserForm1.Show

End Sub

Bạn chỉ giúp minh với, mình mò mà không được, phần PL nó không add dc text bạn ah.

Cảm ơn bạn


  • 0

#24 phuong44e1

phuong44e1

    Edu level: li4

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

Đã gửi 18 March 2016 - 10:30 AM

Có ai giúp mình dc không? Mình cũng tìm mãi mà ko biết lý do gì.

Chạy không báo lỗi nhưng ko add dc text lên PL


  • 0

#25 phuong44e1

phuong44e1

    Edu level: li4

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

Đã gửi 18 March 2016 - 02:10 PM

Bác nào xem giúp dc không?


  • -1

#26 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 18 March 2016 - 02:23 PM

Cái thú của lập trình là tự mình tìm ra được lỗi của chương trình.

Bạn thử Debug chưa ?

Gợi ý

15454_addtext_error.png


  • 1

#27 phuong44e1

phuong44e1

    Edu level: li4

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

Đã gửi 18 March 2016 - 03:53 PM

Cái thú của lập trình là tự mình tìm ra được lỗi của chương trình.

Bạn thử Debug chưa ?

Gợi ý

15454_addtext_error.png

Mình cũng chỉ là đang học thôi, đây là những bài mình đang tập làm nên cũng chưa biết debug

Đang cố gắng học từ các bài thực hành. Cũng cố gắng suy luận mà ko ra vì cũng chưa biết nhiều

Nếu như bạn hướng dẫn lỗi ở 2 chỗ này thì đúng là cái mình ko biết rồi. vì như mình nghĩ đối với lineobject nó dùng vậy thì pl nó cũng tương tự. Khong biết cú pháp có gì khác không?

Theo mình nghĩ chỗ Stapt ở dưới nó là tham chiếu điểm chèn đã được dịnh nghĩa ở trên

Còn chỗ Stapt trên thì mình thấy nó cũng chỉ là 1 ký hiệu thôi, nó tương tự phép gán pt1=ThisDrawing.Ultility.Getpoint...

Nhờ bạn chỉ rõ hơn hoặc sửa giúp mình, mình sẽ học được từ bài của bạn.

Cảm ơn bạn 


  • 0

#28 phuong44e1

phuong44e1

    Edu level: li4

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

Đã gửi 19 March 2016 - 11:23 AM

Bạn gia_bach chỉ giúp mình dc không?


  • 0

#29 dinhvantrang

dinhvantrang

    biết lệnh copy

  • Members
  • PipPipPip
  • 117 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 22 March 2016 - 10:57 PM

Gửi bạn code addText vào giưa Polyline chọn trên màn hình nhe

 

http://www.cadviet.c...xt_document.txt


  • 1

Thanks and Best Regards

Skype : dinhvantrang73


#30 phuong44e1

phuong44e1

    Edu level: li4

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

Đã gửi 23 March 2016 - 11:10 AM

Gửi bạn code addText vào giưa Polyline chọn trên màn hình nhe

 

http://www.cadviet.c...xt_document.txt

 Cảm ơn bạn rất nhiều.


  • 0

#31 phuong44e1

phuong44e1

    Edu level: li4

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

Đã gửi 28 March 2016 - 11:49 AM

Bạn xem giúp mình được không?
khi chạy lần 1 nó vẫn báo lỗi ở dòng  SS.SelectOnScreen FT, FD
Sau đó cho chạy tiếp thì nó mới chạy được
Private Sub CommandButton1_Click()
Dim SS As AcadSelectionSet
If ThisDrawing.SelectionSets.Count > 0 Then
For Each SS In ThisDrawing.SelectionSets
If SS.Name = "Kira" Then
SS.Delete
Exit For
End If
Next
End If
Set SS = ThisDrawing.SelectionSets.Add("Kira")
Dim FT(0) As Integer
Dim FD(0) As Variant
FT(0) = 0: FD(0) = "LWPolyline"

SS.SelectOnScreen FT, FD
Dim LWPolylineObj As AcadLWPolyline
Dim TextPnt(2) As Double
Dim TextObj As AcadText
Dim i As Integer
For Each LWPolylineObj In SS
For i = 0 To UBound(LWPolylineObj.Coordinates) Step 2
'Toa do X
TextPnt(0) = 0.5 * (LWPolylineObj.Coordinates(i) + LWPolylineObj.Coordinates(i + 2))
'Toa do Y
TextPnt(1) = 0.5 * (LWPolylineObj.Coordinates(i + 1) + LWPolylineObj.Coordinates(i + 3))

Set TextObj = ThisDrawing.ModelSpace.AddText("Kira", TextPnt, LWPolylineObj.Length / 20)

If i + 3 = UBound(LWPolylineObj.Coordinates) Then
Exit For
End If
Next
Next

End Sub
  • 0

#32 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 28 March 2016 - 03:25 PM

Bạn xem giúp mình được không?
khi chạy lần 1 nó vẫn báo lỗi ở dòng  SS.SelectOnScreen FT, FD
Sau đó cho chạy tiếp thì nó mới chạy được
Private Sub CommandButton1_Click()
............

End Sub

Quên bài cũ rùi ?!

 

Thêm Hide và Show hộp thoại ở đầu và cuối Sub :


  • 1

#33 phuong44e1

phuong44e1

    Edu level: li4

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

Đã gửi 29 March 2016 - 08:30 AM

Quên bài cũ rùi ?!
 
Thêm Hide và Show hộp thoại ở đầu và cuối Sub :

Thanks bạn nhé.
  • 0