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

[valentine999 0]

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.

[valentine999 0]

Ai làm được giúp em thì pm facebook datviphp91@yahoo.com.vn nhé.  :blink:

[phamngoctukts 717]

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

[dinhvantrang 151]

 

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.

Similar topics from web:

Xin viết dùng mã vba thay thế cho hàm vlookup

Đôi lời giới thiệu sách: Sách VBA TRONG EXCEL CẢI THIỆN VÀ ...

Hỏi cách ẩn dòng cột bằng VBA

Tặng mọi người Addins thao tác và chỉnh sửa Code trong VBA viết ...

Hỏi đáp về VBA

Lấy ý kiến về việc tổ chức lớp học VBA ở TPHCM [Lưu Trữ]

Đố vui về VBA!

Browse đến một CommAddin bằng VBA

Giúp em viết VBA chuyển dữ liệu từ sheet này sang sheet khác theo ...

Giải Pháp Excel phát hành sách

Hỏi về cách tìm ra số trong một bảng mà có hiệu số nhỏ nhất so với ...

Tạo VBA Treeview

Tham khảo học VBA [Lưu Trữ]

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!

[Anlee 3]

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