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

ngoctanvt

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

  • Số lượng nội dung

    19

  • Đã tham gia

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

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

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

    Xin chào mọi người. Mình đang làm một ứng dụng vẽ kích thước nhanh trong không gian 3D, và mình đang có một số vướng mắc. Rất mong nhận được sự giúp đỡ từ diễn đàn. Xin cảm ơn.

    Các bạn xem bản vẽ ban đầu, bản vẽ kết quả và code VBA mình gửi kèm bên dưới.

    Ứng dụng của mình thực hiện theo các bước:

    1.    Chọn 3 điểm P1,P2,P3 trên màn hình

    image.png.f033a99b612dc5c870d9861b35dab00a.png

    3 điểm này sẽ phục vụ cho việc tạo UCS mới, lần lượt là gốc tọa độ, điểm trên trục X và điểm trên trục Y

    2.    Nhập khoảng cách giữa các kích thước, mặc định là 200mm.

    3.    Chọn đường cong phía trên (đường cong này có thể là Line, Arc, Polyline, 2DPolyline, 3D Polyline, Spline…).

    image.png.0ae88cf975d894de01fb9e29244c77e6.png

     

    Các bước tính toán để ra kết quả:

    1.    Tạo UCS mới theo 3 điểm P1, P2, P3 ở trên

    2.    Tạo 1 3DPolyline vuông góc với đoạn P1P2 có chiều dài bằng P1P2, điểm đầu của polyline nằm trên đoạn P1P2

    image.png.b40b9a390185537cf2c52e56e484994b.png

    3.    Tìm giao điểm của 3DPolyline vừa tạo và đường cong đã chọn

    4.    Gán điểm cuối của 3DPolyline là giao điểm vừa tìm được

    5.    Vẽ kích thước, 2 điểm đầu và cuối của kích thước chính là 2 điểm đầu và cuối của 3DPolyline. Điểm chèn Text của kích thước là trung điểm của 3DPolyline.

    6.    Tiến hành tương tự đến hết chiều dài đoạn P1P2 với khoảng cách giữa các kích thước mặc định là 200mm.

     

    Hiện tại chương trình của mình đang gặp một số lỗi:

    1.    Điểm đầu và cuối của kích thước được tạo ra đã đúng yêu cầu nhưng điểm đặt của Text ghi kích thước thì chưa đúng. Mình không hiểu tại sao điểm đặt Text này luôn nằm trên mặt phẳng XY của WCS

    2.    Chương trình chỉ hoạt động được nếu đường cong phía trên là 1 đường duy nhất. Nếu thay đường cong phía trên bằng 2 hay nhiều đoạn cong nối tiếp nhau thì sẽ xảy ra lỗi.

    Ketqua.dwg

    Test.dwg

    Test.rar

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

    Em đang làm chương trình tính sự hiệu quả khi cắt thép tấm để thi công.

     

    Trong bản vẽ cắt thép đính kèm theo:

    - Các tấm tôn có màu 193

    - Các chi tiết cần cắt có màu 20

    - Các lỗ khoét của chi tiết có màu 72

    Hiệu quả (%) = (tổng diện tích chi tiết cắt - tổng diện tích lỗ khoét) / tổng diện tích tôn * 100

     

    Nhưng khi tính tổng diện tích theo từng màu thì ko được. Em muốn lọc các chi tiết theo màu, ko lọc theo layer.

     

    Sub Nesting_Percentage()
     
        On Error Resume Next
        
        '-------------------------------
        
        Dim SS2 As AcadSelectionSet
        Dim FilterType2(0 To 7) As Integer
        Dim FilterData2(0 To 7) As Variant
        Dim ToleArea As Double
        Dim PartArea As Double
        Dim HoleArea As Double
        Dim SumToleArea As Double
        Dim SumPartArea As Double
        Dim SumHoleArea As Double
        Dim Percentage As Double
        Dim PolylineObj As AcadLWPolyline
        
        
        '-------------------------------------------------
        Set SS2 = ThisDrawing.SelectionSets("TNT2")
            If Err <> 0 Then
                Err.Clear
                Set SS2 = ThisDrawing.SelectionSets.Add("TNT2")
            Else
                SS2.Clear
            End If
     
        FilterType2(0) = -4: FilterData2(0) = "<AND"
        FilterType2(1) = 0: FilterData2(1) = "LWPolyline"
        FilterType2(2) = -4: FilterData2(2) = "<OR"
        FilterType2(3) = 62: FilterData2(3) = 193
        FilterType2(4) = 62: FilterData2(4) = 20
        FilterType2(5) = 62: FilterData2(5) = 72
        FilterType2(6) = -4: FilterData2(6) = "OR>"
        FilterType2(7) = -4: FilterData2(7) = "AND>"
        
        SS2.SelectOnScreen FilterType2, FilterData2
        
                
        For Each PolylineObj In SS2
            If PolylineObj.TrueColor = 20 Then
                PartArea = PolylineObj.Area
                SumPartArea = SumPartArea + PartArea
            ElseIf PolylineObj.TrueColor = 72 Then
                HoleArea = PolylineObj.Area
                SumHoleArea = SumHoleArea + HoleArea
            ElseIf PolylineObj.TrueColor = 193 Then
                ToleArea = PolylineObj.Area
                SumToleArea = SumToleArea + ToleArea
            End If
        Next PolylineObj
        SS2.Delete
        
        Percentage = Round((SumPartArea - SumHoleArea) / SumToleArea * 100, 2)
        MsgBox "Used: " & CStr(Percentage) & "%"
        
    End Sub
     
     

     

    http://www.cadviet.com/upfiles/6/57144_cutting.dwg

     

     

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

    Nhờ các anh kiểm tra giúp em chương trình VBA này.

    Chương trình có chức năng: chọn Polyline gốc, sau đó chọn các Polyline khác có cùng diện tích với Polyline gốc, gán layer của Polyline gốc cho các Polyline chọn sau. Vì trong bản vẽ có nhiều nhóm Polyline có diện tích bằng nhau nhưng nằm trên các layer khác nhau & ở các vị trí khác nhau. Dùng lệnh MA thì rất lâu.

    Em xin cảm ơn.

×