Đến nội dung


Hình ảnh
- - - - -

Nhờ Kiểm Tra Lỗi Chương Trình Vba


  • Please log in to reply
3 replies to this topic

#1 ngoctanvt

ngoctanvt

    biết zoom

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

Đã gửi 11 August 2016 - 11:17 PM

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.c...144_cutting.dwg

 

 


  • 0

#2 ngoctanvt

ngoctanvt

    biết zoom

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

Đã gửi 11 August 2016 - 11:20 PM

File chương trình VBA đây a.

 http://www.cadviet.c...6/57144_abc.txt


  • 0

#3 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 12 August 2016 - 07:25 AM

Thay PolylineObj.TrueColor bằng : PolylineObj.color

 

Tuy nhiên cần chú ý khi đối tượng có màu là ByLayer.


  • 1

#4 ngoctanvt

ngoctanvt

    biết zoom

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

Đã gửi 12 August 2016 - 10:47 AM

Chương trình đã chạy ok rồi. Em cảm ơn anh gia_bach :)


  • 0