Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
valentine999

Cần các anh cao thủ về VBA chỉ giáo

Các bài được khuyến nghị

tình hình là thầy dạy TĐHTK bắt viết code lệnh xóa các đoạn thẳng vuông góc với trục Ox có trong bản vẽ.em nghiên cứu mãi mà không ra được.vậy có anh nào biết thì hộ em chút.em xin chân thành cảm ơn và hậu tạ.

à nếu đoạn thẳng vuông góc với trục Ox thì có tọa độ theo phương x của điểm đầu và điểm cuối băng nhau.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Của bạn đây:



Sub xoa()
On Error Resume Next
Dim ss As AcadSelectionSet
Dim mode As Integer
mode = acSelectionSetAll
Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    gpCode(0) = 0
    dataValue(0) = "Line"
ThisDrawing.SelectionSets.Item("SS").Delete
Dim obj As AcadObject
Dim p1 As Variant
Dim p2 As Variant
Set ss = ThisDrawing.SelectionSets.Add("SS")
ss.Select mode, , , gpCode, dataValue
For Each obj In ss
p1 = obj.StartPoint
p2 = obj.EndPoint
If p1(0) = p2(0) Then
obj.Erase
End If
Next
End Sub

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

tình hình là thầy dạy TĐHTK bắt viết code lệnh xóa các đoạn thẳng vuông góc với trục Ox có trong bản vẽ.em nghiên cứu mãi mà không ra được.vậy có anh nào biết thì hộ em chút.em xin chân thành cảm ơn và hậu tạ.

à nếu đoạn thẳng vuông góc với trục Ox thì có tọa độ theo phương x của điểm đầu và điểm cuối băng nhau.

Cái này dễ mừ bạn.Bạn tạo một SelectionSet với bộ lọc là Line,Chạy một vòng lặp trong SelectionSet này nếu Line nào thoả mãn điều kiện StartPoint(0)=EndPoint(0) thì Delete nó đi thôi.

Chúc bạn thành công!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Của bạn đây.

Sub Del()
Dim SSetObj As AcadSelectionSet
Dim Ent As AcadLine
Dim StPoint As Variant
Dim EdPoint As Variant
Dim GpCode(0) As Integer
Dim Data(0) As Variant
'dinh nghia bo loc
GpCode(0) = 0: Data(0) = "Line"
'chon doi tuong tren man hinh
On Error Resume Next
ThisDrawing.SelectionSets("MySS").Delete
Set SSetObj = ThisDrawing.SelectionSets.Add("MySS")
SSetObj.SelectOnScreen GpCode, Data
'thao tac trong selectionset
For Each Ent In SSetObj
    StPoint = Ent.StartPoint
    EdPoint = Ent.EndPoint
'dieu kien vuong goc voi ox
    If StPoint(0) = EdPoint(0) Then
        Ent.Delete
    End If
   
Next

End Sub
 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×