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

Huyminer

Thành viên
  • Số lượng nội dung

    7
  • Đã tham gia

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

  • Ngày trúng

    1

Cộng đồng

-11 (kém)

About Huyminer

  • Cấp bậc
    biết pan

Khách truy cập Tiểu sử gần đây

Khối khách truy cập gần đây đã bị vô hiệu và không được hiển thị cho người dùng khác.

  1. Mình đã giải được bài toán này rồi nhé :D Bị nhầm 1 chỗ ở chỗ gán vòng lặp nên bị chạy linh tinh :D
  2. Mình đã tạo 1 trục ucs mới tương đối với tập điểm, và tran điểm sang trục ucs đó để sort, nhưng vẫn đang gặp vấn đề với đoạn code kia Tìm được 2 điểm trên cùng bên trái và phải, sau đó tìm điểm ở khúc giữa 2 điểm đó để sort, nhưng chỉ sort được mỗi dòng đầu tiên những dòng sau bị gán hết vào tọa độ 0.0.0
  3. If SSETO.Count > 0 Then ReDim Preserve arPoint(SSETO.Count - 1, 2) ReDim Preserve arPointN(SSETO.Count - 1, 2) For iSSETO = 0 To SSETO.Count - 1 Set SGETO = SSETO.Item(iSSETO) PointC = SGETO.Center arPoint(iSSETO, 0) = PointC(0): arPoint(iSSETO, 1) = PointC(1): arPoint(iSSETO, 2) = PointC(2) Next iSSETO aCount = 0 For iCount = LBound(arPoint) To UBound(arPoint) For jCount = LBound(arPoint) To UBound(arPoint) If jCount = LBound(arPoint) Then rmPoint(0) = arPoint(jCount, 0): rmPoint(1) = arPoint(jCount, 1): rmPoint(2) = arPoint(jCount, 2) rmPointUCS = ThisDrawing.Utility.TranslateCoordinates(rmPoint, acWorld, acUCS, False) lmPoint(0) = arPoint(jCount, 0): lmPoint(1) = arPoint(jCount, 1): lmPoint(2) = arPoint(jCount, 2) lmPointUCS = ThisDrawing.Utility.TranslateCoordinates(lmPoint, acWorld, acUCS, False) Else rmPointUCS = ThisDrawing.Utility.TranslateCoordinates(rmPoint, acWorld, acUCS, False) lmPointUCS = ThisDrawing.Utility.TranslateCoordinates(lmPoint, acWorld, acUCS, False) End If PointD(0) = arPoint(jCount, 0): PointD(1) = arPoint(jCount, 1): PointD(2) = arPoint(jCount, 2) PointUCS = ThisDrawing.Utility.TranslateCoordinates(PointD, acWorld, acUCS, False) If PointUCS(0) > rmPointUCS(0) And PointUCS(1) > rmPointUCS(1) Then rmPoint(0) = arPoint(jCount, 0): rmPoint(1) = arPoint(jCount, 1): rmPoint(2) = arPoint(jCount, 2) rCount = jCount End If If lmPointUCS(0) = 0# Then lmPointUCS(0) = PointUCS(0) lCount = jCount End If If PointUCS(0) < lmPointUCS(0) And PointUCS(1) > lmPointUCS(1) Then lmPoint(0) = arPoint(jCount, 0): lmPoint(1) = arPoint(jCount, 1): lmPoint(2) = arPoint(jCount, 2) lCount = jCount End If Next jCount For jCount = LBound(arPoint) To UBound(arPoint) rmPoint(0) = arPoint(rCount, 0): rmPoint(1) = arPoint(rCount, 1): rmPoint(2) = arPoint(rCount, 2) rmPointUCS = ThisDrawing.Utility.TranslateCoordinates(rmPoint, acWorld, acUCS, False) lmPoint(0) = arPoint(lCount, 0): lmPoint(1) = arPoint(lCount, 1): lmPoint(2) = arPoint(lCount, 2) lmPointUCS = ThisDrawing.Utility.TranslateCoordinates(lmPoint, acWorld, acUCS, False) PointD(0) = arPoint(jCount, 0): PointD(1) = arPoint(jCount, 1): PointD(2) = arPoint(jCount, 2) PointUCS = ThisDrawing.Utility.TranslateCoordinates(PointD, acWorld, acUCS, False) If (PointUCS(0) <= rmPointUCS(0) And PointUCS(0) >= lmPointUCS(0)) And ((PointUCS(1) >= rmPointUCS(1) And PointUCS(1) <= lmPointUCS(1)) Or (PointUCS(1) <= rmPointUCS(1) And PointUCS(1) >= lmPointUCS(1))) Then arPointN(aCount, 0) = PointD(0): arPointN(aCount, 1) = PointD(1): arPointN(aCount, 2) = PointD(2) arPoint(jCount, 0) = 0#: arPoint(jCount, 1) = 0#: arPoint(jCount, 2) = 0# If aCount + 1 <= UBound(arPoint) Then aCount = aCount + 1 End If Next jCount If iCount = LBound(arPoint) Then fCount = LBound(arPoint) sCount = aCount - 1 Else If sCount + 1 <= UBound(arPoint) Then fCount = sCount + 1 If aCount = UBound(arPoint) Then sCount = aCount - 1 Else aCount = UBound(arPoint) End If End If For jCount = fCount To sCount If jCount + 1 <= sCount Then For xCount = jCount + 1 To sCount PointS(0) = arPointN(xCount - 1, 0): PointS(1) = arPointN(xCount - 1, 1): PointS(2) = arPointN(xCount - 1, 2) PointUCSS = ThisDrawing.Utility.TranslateCoordinates(PointS, acWorld, acUCS, False) PointD(0) = arPointN(xCount, 0): PointD(1) = arPointN(xCount, 1): PointD(2) = arPointN(xCount, 2) PointUCS = ThisDrawing.Utility.TranslateCoordinates(PointD, acWorld, acUCS, False) If PointUCSS(0) < PointUCS(0) Then sortPoint(0) = arPointN(xCount - 1, 0): sortPoint(1) = arPointN(xCount - 1, 1): sortPoint(2) = arPointN(xCount - 1, 2) arPointN(xCount - 1, 0) = arPointN(xCount, 0): arPointN(xCount - 1, 1) = arPointN(xCount, 1): arPointN(xCount - 1, 2) = arPointN(xCount, 2) arPointN(xCount, 0) = sortPoint(0): arPointN(xCount, 1) = sortPoint(1): arPointN(xCount, 2) = sortPoint(2) End If Next xCount End If Next jCount Next iCount For iCount = LBound(arPointN) To UBound(arPointN) PoinT(0) = arPointN(iCount, 0): PoinT(1) = arPointN(iCount, 1): PoinT(2) = arPointN(iCount, 2) Set AddText = ThisDrawing.ModelSpace.AddText(iCount, PoinT, 2) Next iCount End If SSETO.Delete Exit Sub Mình có thử viết 1 đoạn như này để lọc rồi cho vào 1 mảng mới, nhưng có vẻ như không thành công, vì sau khi gán giá trị 0 vào mảng cũ thì những lần lọc sau lại lấy giá trị 0 cho vào mảng mới. Mọi người xem giúp mình xem như n
  4. sort toàn bộ tập điểm luôn chứ sort 1 vài điểm thì nói làm gì
  5. đây là file hck.dwg
  6. tập hợp các điểm của mình không đơn thuần là nó chạy theo trục XY Các tập điểm có thể chạy xiên như này chứ không thẳng hàng nên phép chiếu và so sánh các điểm với trục x và y mình đã thử rồi và không thành công
  7. Chào mọi người! Hiện giờ mình đang viết 1 đoạn mã VBA phục vụ công việc. Mình gặp vấn đề sắp xếp thứ tự các điểm ngẫu nhiên có hình minh họa phía dưới Mình đang sắp xếp bằng phương pháp x+y và xếp từ lớn tới nhỏ nhưng không được như ý lắm Mọi người có thể giúp mình sắp xếp, đánh số các điểm theo tứ tự từ trên xuống dưới, phải qua trái được không? Mình xếp như kia đoạn đầu đoạn cuối, nhưng khúc giữa lại bị lỗi Xin cảm ơn!
×