Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
4 replies to this topic

#1 valentine999

valentine999

    Chưa sử dụng CAD

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

Đã gửi 18 March 2013 - 06:41 PM

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.


  • 0

#2 valentine999

valentine999

    Chưa sử dụng CAD

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

Đã gửi 18 March 2013 - 06:43 PM

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


  • 0

#3 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 March 2013 - 07:59 PM

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

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#4 dinhvantrang

dinhvantrang

    biết lệnh copy

  • Members
  • PipPipPip
  • 117 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 23 July 2013 - 10:41 AM

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!


  • 0

Thanks and Best Regards

Skype : dinhvantrang73


#5 Anlee

Anlee

    biết zoom

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

Đã gửi 23 July 2013 - 01:30 PM

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
 


  • 0