Chuyển đến nội dung
Diễn đàn CADViet

phuong44e1

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    49

  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi phuong44e1

  3. Đã đăng · Trả lời báo cáo

    e chào bác gia_bach,

    lâu rồi lại mới có việc nhờ các bác hỗ trợ, chả là mấy cái tool vba lúc trước viết thì e tạo 1 cái pull_down menu để nó chạy macro.

    Mấy cái tạo menu và tool vba đó vẫn chạy trên autocad 2010- 64 bit và cad 2015- 64 bit. Giờ e đổi sang dùng win10 nên cài sang cad 2020 thì load cái menu nó không được nữa bác ah.

    Vào load macro trực tiếp từ Run VBA macro thì nó báo lỗi, e cũng chẳng biết sao.

    Nhờ các bác xem hộ e cái phần load menu giúp e với ạ

    E cảm ơn nhiều.

     

     

    tienich.rar

  8. Đã đăng · Trả lời báo cáo

    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

  10. Đã đăng · Trả lời báo cáo

    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 

    Chắc bạn gia_bach bận bịu quá. bạn Ketxu chỉ giúp mình được không?

    không có ai giúp dc mình sao? là các bạn ko có hứng giúp hay ko giúp dc vậy.

    Vậy trên diễn đàn có bác nào dạy được BVA không mình đăng ký học.

  11. Đã đăng · Trả lời báo cáo

    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 

    Chắc bạn gia_bach bận bịu quá. bạn Ketxu chỉ giúp mình được không?

  13. Đã đăng · Trả lời báo cáo

    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 

  16. Đã đăng · Trả lời báo cáo

    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

  18. Đã đăng · Trả lời báo cáo

     

    Code cho bạn t/hợp đường thẳng, t/hợp Poyline tự ngâm cứu nhé.

    Public Sub AddTextToMidPoint()
    On Error Resume Next
    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 length As Double
    Dim ang As Double
    ThisDrawing.Utility.GetEntity objEntity, varPick, "Select an entity"
    If objEntity Is Nothing Then
        MsgBox "No entity was selected"
        Exit Sub ' exit if no entity picked
    End If
    
    If objEntity.ObjectName = "AcDbLine" Then
        Set lineObj = objEntity
        staPt = lineObj.StartPoint
        length = lineObj.length
        ang = lineObj.Angle
        midPt = ThisDrawing.Utility.PolarPoint(staPt, ang, length / 2)
        
        Set textObj = ThisDrawing.ModelSpace.AddText(ThisDrawing.Utility.RealToString(length, 2, 2), midPt, length / 20)
        textObj.Rotation = ang
    ElseIf objEntity.ObjectName = "AcDbPolyline" Then
        Set plineObj = objEntity
        ' self study
    End If

End Sub

    cảm ơn bạn nhiều. rất hữu ích

  19. Đã đăng · Trả lời báo cáo

    Các hàm lấy điểm đầu, cuối:

     

    Dim lineObj As AcadLine

    lineObj.StartPoint và lineObj.EndPoint

     

    Các hàm lấy tọa độ đỉnh pline:

     

    Dim plineObj As AcadPolyline

    plineObj.Coordinates và plineObj.Coordinate(index)

     

    Bạn xem help phần:

    - ActiveX and VBA Reference - Objects - Line object & Polyline object

    Cảm ơn bạn nhưng mình làm mà nó vẫn báo lỗi

    Dim entObj =AcadObject

    if entObj .ObjectName = "AcDbPolyline" then

    Set dttext = ThisDrawing.Modelspace.AddText (txt1, entObject.Coordinates, tHeight)

    Làm thế này thì nó báo lỗi nhưn nếu mình làm như sau

    if entObj .ObjectName = "AcDbPolyline" then

    pt = ThisDrawing.Ultilyti.Getpoint (,"Select point to add:")

    Set dttext = ThisDrawing.Modelspace.AddText (txt1, pt1, tHeight)

    Thì nó lại cho add text nhưng phải tự pick chọn điểm và không tự động chọn điểm đầu PL nữa

  20. Đã đăng · Trả lời báo cáo

    Bạn gửi file dvb đó lên đây mình xem được không :) File MDB :o Access k phải hàng chùa, nên đã từ lâu ít người muốn dính tới nó rồi

    Bạn ketxu giúp mình với, 

    Với obj line, PL có sẵn rồi thì dùng hàm nào để get startpoint, midpoint, endpoind của nó vậy?

    Như trong lisp thì dùng hàm vlax-curve-getstartpoind, vlax-curve-getendtpoind còn trong vba là hàm gì vậy. Mình mò hoài mà ko dc

    Thank!

    • Vote giảm 1

  22. Đã đăng · Trả lời báo cáo

    bạn muốn chọn được đối tượng Line/Polyline có sẵn thì phải tạo ra một tập chọn để chưa các đối tượng đó ---> sau đó lặp qua từng phần tử Line/Polyline trong tập chọn để lấy đc điểm đầu, điểm cuối >>> AddText bình thường thôi bạn à

    Bạn có thể giúp mình cái hàm để get cái điểm đó dc không, như trong lisp thì nó nó là (vlax-curve-getstartpoint obj) , (vlax-curve-getndpoint obj) còn không biết VBA nó là thế nào vậy bạn.

  23. Đã đăng · Trả lời báo cáo

    May quá gặp dc người đây rồi

    Mình đang gặp rắc rối chỗ này. Ở đây thì bạn vẽ line với 2 điểm pt1, pt2 được chọn sau đó gán text với toa độ điểm chèn xác định từ pt1, pt2

    Vậy cho mình hỏi nếu line, pl này đã có sẵn thì làm sao để mình lấy dc tọa độ điểm đầu, giữa, cuối của nó để xác định điểm chèn.

    Cảm ơn bạn nhiều.

    Có ai giúp tôi dc không?

  24. Đã đăng · Trả lời báo cáo

     

    Gửi bạn nè: 

     

    http://www.cadviet.com/upfiles/3/37575_addtext.txt

    Sub AddTextMidPoint()
        On Error Resume Next
        Dim StrText As String
        StrText = ThisDrawing.Utility.GetString(True, vbCrLf & "Input Text")
        Dim Pt1 As Variant
        Dim Pt2 As Variant
        Dim lineObj As AcadLine
        Dim textObj As AcadText
        Dim TxtPnt(2) As Double
        Pt1 = ThisDrawing.Utility.GetPoint(, "diem dau : ")
        Pt2 = ThisDrawing.Utility.GetPoint(Pt1, "diem cuoi: ")
        TxtPnt(0) = 0.5 * (Pt1(0) + Pt2(0))
        TxtPnt(1) = 0.5 * (Pt1(1) + Pt2(1))
        TxtPnt(2) = 0.5 * (Pt1(2) + Pt2(2))
        Set lineObj = ThisDrawing.ModelSpace.AddLine(Pt1, Pt2)
        Set textObj = ThisDrawing.ModelSpace.AddText(StrText, TxtPnt, lineObj.Length / 20)
        textObj.Alignment = acAlignmentMiddleCenter
        textObj.TextAlignmentPoint = TxtPnt
    End Sub
    Sub AddTextMidPoint()
        On Error Resume Next
        Dim StrText As String
        StrText = ThisDrawing.Utility.GetString(True, vbCrLf & "Input Text")
        Dim Pt1 As Variant
        Dim Pt2 As Variant
        Dim lineObj As AcadLine
        Dim textObj As AcadText
        Dim TxtPnt(2) As Double
        Pt1 = ThisDrawing.Utility.GetPoint(, "diem dau : ")
        Pt2 = ThisDrawing.Utility.GetPoint(Pt1, "diem cuoi: ")
        TxtPnt(0) = 0.5 * (Pt1(0) + Pt2(0))
        TxtPnt(1) = 0.5 * (Pt1(1) + Pt2(1))
        TxtPnt(2) = 0.5 * (Pt1(2) + Pt2(2))
        Set lineObj = ThisDrawing.ModelSpace.AddLine(Pt1, Pt2)
        Set textObj = ThisDrawing.ModelSpace.AddText(StrText, TxtPnt, lineObj.Length / 20)
        textObj.Alignment = acAlignmentMiddleCenter
        textObj.TextAlignmentPoint = TxtPnt
    End Sub

     

    May quá gặp dc người đây rồi

    Mình đang gặp rắc rối chỗ này. Ở đây thì bạn vẽ line với 2 điểm pt1, pt2 được chọn sau đó gán text với toa độ điểm chèn xác định từ pt1, pt2

    Vậy cho mình hỏi nếu line, pl này đã có sẵn thì làm sao để mình lấy dc tọa độ điểm đầu, giữa, cuối của nó để xác định điểm chèn.

    Cảm ơn bạn nhiều.

  25. Đã đăng · Trả lời báo cáo

    Có bác nào biết về Dynamic block trong ZW cad không giúp mình với

    Mình bình thwowngf dùng hang cack cad 2010, nhwng giờ vào cty nó dùng ZW cad 2015 của Hồ Cẩm Đào thì phải

    có cái là cái dynamic block nó không cho swar các đối twowngj trong đó và hàm (vlax-invoke blk 'getdynamicblockproperties)thì nó báo là không hiểu)

    Ai biết giúp mình với. Làm sao để nó nhận đwowcj cái hàm này?

×