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

tronganh210494@gmail.com

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

  • Số lượng nội dung

    13

  • Đã tham gia

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

Bài đăng được đăng bởi tronganh210494@gmail.com

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

    17 phút trước, CadExTools đã nói:

    Bạn thử:

    Sub addpoint()

        Dim varpoint As Variant

        varpoint = ThisDrawing.Utility.GetPoint
        
        Set Objpoint = ThisDrawing.ModelSpace.addpoint(varpoint)

        
        Dim objtext As AcadText
        Dim textpoint(2) As Double
        
        textpoint(0) = varpoint(0)
        textpoint(1) = varpoint(1)
        textpoint(2) = varpoint(2) * 1000
            
        Set objtext = ThisDrawing.ModelSpace.addtext(Round(varpoint(2), 3), varpoint, 0.25)
        
    End Sub

    Tuyệt vời bác ơi. e muốn nhờ bác sửa thêm nó làm tròn đến số thứ 2 sau dấu phẩy. 
    ví dụ 0.879-> 0.880 ạ. E cảm ơn bác nhiều.

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

    E là gà mờ mong các bác sửa giúp e vs ạ.
    E có muốn tạo 1 code chấm điểm point và xuất ra text=(cao độ z) của point đó.
    E xin cảm ơn.

     

    Sub addpoint()
        Dim objss As AcadSelectionSet
        Set objss = ThisDrawing.SelectionSets.Add(Now)
            
        Dim FT(0) As Integer
        Dim FD(0) As Variant
        Dim Objpoint As AcadPoint
        Dim point As Variant

        
        point = ThisDrawing.Utility.GetPoint
        
        Set Objpoint = ThisDrawing.ModelSpace.addpoint(point)

        
        Dim objtext As AcadText
        Dim textpoint(3) As Double
        
        For Each Objpoint In objss
            textpoint(0) = Objpoint.point(0)
            textpoint(1) = Objpoint.point(1)
            
        Set objtext = ThisDrawing.ModelSpace.addtext(Round(textpoint(2), 3), Objpoint.textpoint, 0.25)
        
        Next
        objss.Delete
    End Sub
     

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

    Nhờ các cao nhân giúp e với ạ. E muốn thêm tiền nguyên tố "隣地境界線/道路境界線/道路後退線" vào trước text chiều dài xuất ra. Cảm ơn các bác nhiều.

    Sub Addtext()

        Dim objss As AcadSelectionSet
        Set objss = ThisDrawing.SelectionSets.Add(Now)
            
        Dim FT(0) As Integer
        Dim FD(0) As Variant
        
        FT(0) = 0: FD(0) = "LINE"
        
        objss.SelectOnScreen FT, FD
        Dim objline As AcadLine
        Dim objtext As AcadText
        Dim textpoint(2) As Double
        
        For Each objline In objss
            textpoint(0) = 0.5 * (objline.StartPoint(0) + objline.EndPoint(0))
            textpoint(1) = 0.5 * (objline.StartPoint(1) + objline.EndPoint(1))
            
            
            Set objtext = ThisDrawing.ModelSpace.Addtext(Round(objline.Length, 3), objline.StartPoint, 0.25)
            objtext.Rotate textpoint, objline.Angle
            
            objtext.Alignment = acAlignmentBottomCenter
            objtext.TextAlignmentPoint = textpoint
            
            
            
        Next
        objss.Delete
    End Sub

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

    11 giờ trước, dinhvantrang đã nói:

    Video này có lẽ đúng với ý chủ thớt, cần thì tải về dưới phần mô tả video

     

    Cảm ơn bác nhiều. Cho e hỏi thêm có cách nào gán chữ "隣地境界線/道路境界線/道路後退線" vào trước text chiều dài xuất ra ko ạ. e cảm ơn!

    Capture.PNG

×