Đến nội dung


Hình ảnh
- - - - -

Có thể sắp xếp thứ tự các item trong Selectionset theo toạ độ của đối tượng được chọn không?


  • Please log in to reply
10 replies to this topic

#1 ptlong04x1

ptlong04x1

    biết vẽ polygon

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

Đã gửi 08 August 2010 - 08:38 AM

Mình có 1 loạt text trên bản vẽ cần phải đánh số lại (tăng dần hay giảm dần)

Ví dụ : số thứ tự của các bản vẽ, các bản vẽ được sắp xếp từ trái sang phải theo STT tăng dần, nhưng hiện tại chưa được đánh số, mà chỉ các các text giống nhau tại các vị trí đó (hiện tại S.1, S.1, S.1,.... muốn ---> S.1, S.2, S.3,....)

Để làm việc này, mình chọn tất cả các text này bằng window với phương thức SelectOnScreen kết hợp Filter (việc này mình đã làm được), sau khi chạy code đánh số theo kiểu i=i+1... thì các STT không nằm ở vị trí như mong muốn, vì thứ tự tạo ra của các text là khác nhau và mình thường xuyên move đi move khi sắp xếp bản vẽ

Nếu pick từng text thì OK, nhưng lại mất nhiều thời gian và dễ gây nhầm lẫn.

Vậy mình muốn hỏi có cách nào chọn tất cả các text bằng window nhưng vẫn đảm bảo thứ tự các text trong selectionset sắp xếp theo thứ tự tăng dần của toạ độ X (hay Y) của điểm chèn của các text đó không. Xin cảm ơn!
  • 0

#2 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 993 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 08 August 2010 - 08:50 AM

Mình có 1 loạt text trên bản vẽ cần phải đánh số lại (tăng dần hay giảm dần)

Ví dụ : số thứ tự của các bản vẽ, các bản vẽ được sắp xếp từ trái sang phải theo STT tăng dần, nhưng hiện tại chưa được đánh số, mà chỉ các các text giống nhau tại các vị trí đó (hiện tại S.1, S.1, S.1,.... muốn ---> S.1, S.2, S.3,....)

Để làm việc này, mình chọn tất cả các text này bằng window với phương thức SelectOnScreen kết hợp Filter (việc này mình đã làm được), sau khi chạy code đánh số theo kiểu i=i+1... thì các STT không nằm ở vị trí như mong muốn, vì thứ tự tạo ra của các text là khác nhau và mình thường xuyên move đi move khi sắp xếp bản vẽ

Nếu pick từng text thì OK, nhưng lại mất nhiều thời gian và dễ gây nhầm lẫn.

Vậy mình muốn hỏi có cách nào chọn tất cả các text bằng window nhưng vẫn đảm bảo thứ tự các text trong selectionset sắp xếp theo thứ tự tăng dần của toạ độ X (hay Y) của điểm chèn của các text đó không. Xin cảm ơn!

Bạn hãy sử dụng lệnh Tcount có sẵn trong Autocad.
  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#3 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 993 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 08 August 2010 - 08:53 AM

Mình có 1 loạt text trên bản vẽ cần phải đánh số lại (tăng dần hay giảm dần)

Ví dụ : số thứ tự của các bản vẽ, các bản vẽ được sắp xếp từ trái sang phải theo STT tăng dần, nhưng hiện tại chưa được đánh số, mà chỉ các các text giống nhau tại các vị trí đó (hiện tại S.1, S.1, S.1,.... muốn ---> S.1, S.2, S.3,....)

Để làm việc này, mình chọn tất cả các text này bằng window với phương thức SelectOnScreen kết hợp Filter (việc này mình đã làm được), sau khi chạy code đánh số theo kiểu i=i+1... thì các STT không nằm ở vị trí như mong muốn, vì thứ tự tạo ra của các text là khác nhau và mình thường xuyên move đi move khi sắp xếp bản vẽ

Nếu pick từng text thì OK, nhưng lại mất nhiều thời gian và dễ gây nhầm lẫn.

Vậy mình muốn hỏi có cách nào chọn tất cả các text bằng window nhưng vẫn đảm bảo thứ tự các text trong selectionset sắp xếp theo thứ tự tăng dần của toạ độ X (hay Y) của điểm chèn của các text đó không. Xin cảm ơn!

Tiện thể gửi cho bạn lisp đánh số thứ tự theo cách kích chuột trực tiếp (Cả với dạng Attribute)
http://www.4shared.c...u_tu_tang_.html
  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 08 August 2010 - 11:09 AM

Bạn hãy sử dụng lệnh Tcount có sẵn trong Autocad.


Tiện thể gửi cho bạn lisp đánh số thứ tự theo cách kích chuột trực tiếp (Cả với dạng Attribute)
http://www.4shared.c...u_tu_tang_.html


Nhưng mà đây là chuyên mục VBA cơ mà Bạn thanhduan2407 à?????
bạn ptlong04x1 post bài này trong chuyên mục VBA => tức là đang hỏi về VBA chứ không phải về AutoLisp!
  • 1

#5 Jin Yong

Jin Yong

    biết lệnh group

  • Vip
  • PipPipPipPipPipPip
  • 498 Bài viết
Điểm đánh giá: 334 (khá)

Đã gửi 09 August 2010 - 07:19 AM

Có thể lấy được tọa độ của mỗi đối tượng được chọn trong tập hợp đã chọn, có thể tiếp cận theo hương này chăng?
  • 1

Phát triển phần mềm thiết kế Kết cấu Việt Nam - http://www.ketcausoft.com


#6 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 09 August 2010 - 08:29 AM

Có thể lấy được tọa độ của mỗi đối tượng được chọn trong tập hợp đã chọn, có thể tiếp cận theo hương này chăng?


Hướng này là đúng rồi.
Nếu muốn tăng dần theo X thì lưu các tọa độ X thành mảng.
Sắp xếp nổi bọt là có ngay mảng tăng dần. Cần kèm thêm mảng vị trí đối tượng trong tập chọn để đối chiếu sau khi sắp xếp xong.
  • 1
Clear sky!

MF Rock collection.

#7 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 993 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 25 September 2010 - 07:49 PM

Nhưng mà đây là chuyên mục VBA cơ mà Bạn thanhduan2407 à?????
bạn ptlong04x1 post bài này trong chuyên mục VBA => tức là đang hỏi về VBA chứ không phải về AutoLisp!

Cảm ơn bác đã tham gia đóng góp ý kiến.
Em post nhầm sang chủ đề khác. Cảm ơn bác nhiều
  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#8 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 12 June 2012 - 11:26 AM

Hướng này là đúng rồi.
Nếu muốn tăng dần theo X thì lưu các tọa độ X thành mảng.
Sắp xếp nổi bọt là có ngay mảng tăng dần. Cần kèm thêm mảng vị trí đối tượng trong tập chọn để đối chiếu sau khi sắp xếp xong.

Bác anhcos có code tham khảo về vấn đề này không?
Cám ơn !
  • 0

#9 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 27 June 2012 - 09:44 AM


Sub Sort()
Dim fType(0) As Integer, fData(0)
Dim adBlockSS As AcadSelectionSet
Dim adBlock As AcadText
Dim X() As Double
Dim Xo() As Double
Dim i, n As Integer
On Error Resume Next
Set adBlockSS = ThisDrawing.SelectionSets("adBlockSS")
If Err Then Set adBlockSS = ThisDrawing.SelectionSets.Add("adBlockSS")
adBlockSS.Clear
fType(0) = 0: fData(0) = "Text"
adBlockSS.Select acSelectionSetAll, , , fType, fData
i = 0
n = adBlockSS.Count
ReDim X(1 To n)
ReDim Xo(1 To n)
'Sap xep tap doi tuong
For Each adBlock In adBlockSS
i = i + 1
X(i) = adBlock.insertionPoint(0)
Next
Dim j, k As Integer
Dim TG As Double
For j = 1 To n - 1
For k = j + 1 To n
If X(j) > X(k) Then
TG = X(j)
X(j) = X(k)
X(k) = TG
End If
Next
Next
'Hien thi toa do sap xep len man hinh
For j = 1 To n
MsgBox "Toa do thu: X" & j & "la:" & Round(X(j), 2)
Next
End Sub
Đoạn Code này bằng VBA cho phép sắp xếp tọa độ X của tập Selection Set tăng dần.
Nhưng mình đang cần để đánh STT các text theo tọa độ X tăng dần mà đang mắc code
Bạn nào rảnh giúp mình với ?
Cám ơn!
  • 0

#10 garupro

garupro

    biết vẽ circle

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

Đã gửi 02 July 2012 - 01:56 AM

Bạn chỉ cần luu toan bbooj đối tượng vào 1 mảng rùi , xử ly no thui
Code hoàn chỉnh đây , chạy Sub soft


Dim sset As AcadSelectionSet
Dim enty As AcadEntity
Sub soft()
'Lay doi tuong
taoselect
'Khoi tao mang de luu cac doi tuong
Dim enty() As AcadEntity
'Gan doi tuong cho mang
ReDim enty(sset.count)
For I = 0 To sset.count - 1
Set enty(I) = sset(I)
Next
'Sap xep
'Khai bao doi tuong
Dim text As AcadText
Dim mtext As AcadMText
'Xac dinh truc sap xep
Dim truc As String
truc = "X"
chonlai:
truc = ThisDrawing.Utility.GetString(0, "Chon Truc Can Chinh X Or Y [X]:")
If truc <> "" Then
If UCase(truc) <> "X" Then
If UCase(truc) <> "Y" Then
GoTo chonlai
End If
End If
Else
truc = "X"
End If
truc = UCase(truc)
'Khai bao diem
Dim p1 As Double
Dim p2 As Double
Dim diem As Variant
'Bien trung gian
Dim enty_tg As AcadEntity
'Sap xep theo kieu noi bot
For I = 0 To UBound(enty) - 1
If enty(I).ObjectName = "AcDbText" Then
Set text = enty(I)
diem = text.insertionPoint
If truc = "X" Then
p1 = diem(0)
Else
p1 = diem(1)
End If
End If
If enty(I).ObjectName = "AcDbMText" Then
Set mtext = enty(I)
diem = mtext.insertionPoint
If truc = "X" Then
p1 = diem(0)
Else
p1 = diem(1)
End If
End If



For j = I + 1 To UBound(enty) - 1
If enty(j).ObjectName = "AcDbText" Then
Set text = enty(j)
diem = text.insertionPoint
If truc = "X" Then
p2 = diem(0)
Else
p2 = diem(1)
End If
End If
If enty(j).ObjectName = "AcDbMText" Then
Set mtext = enty(j)
diem = mtext.insertionPoint
If truc = "X" Then
p2 = diem(0)
Else
p2 = diem(1)
End If
End If
'So xanh toa do 2 diem va doi vi tri
If p1 > p2 Then
Set enty_tg = enty(I)
Set enty(I) = enty(j)
Set enty(j) = enty_tg
End If
Next
Next
'Su ly cai mang da xap xep
'Khai bao tien to , hau to
Dim tiento As String
Dim hauto As String
Dim vt_batdau As Integer
tiento = ThisDrawing.Utility.GetString(1, "Nhap Tien To :")
hauto = ThisDrawing.Utility.GetString(1, "Nhap Hau To :")
'Lay vi tri bat dau
vt_batdau = Get_Star
Dim tt As String
Dim text_them As String
'Duyet tung doi tuong va thay the text
For I = 0 To UBound(enty) - 1
text_them = tiento & I + vt_batdau & hauto
If enty(I).ObjectName = "AcDbText" Then
Set text = enty(I)
tt = tachtext(text.textString)
text.textString = Replace(text.textString, tt, text_them)
End If
If enty(I).ObjectName = "AcDbMText" Then
Set mtext = enty(I)
tt = tachtext(mtext.textString)
mtext.textString = Replace(mtext.textString, tt, text_them)
End If
Next
Application.Update
End Sub

Function Get_Star() As Integer
On Error GoTo thoat
Get_Star = ThisDrawing.Utility.GetInteger("Nhap Vi tri Bat Dau [0]:")
Exit Function
thoat:
thoat = 0
End Function

Function tachtext(t As String) As String
On Error Resume Next
Dim a As Long
a = InStrRev(t, ";")
t = Mid(t, a + 1)
If t Like "*}*" = True Then
a = InStr(t, "}")
Else
a = InStr(t, "\")
End If
t = Mid(t, 1, a - 1)
tachtext = t
End Function

Sub taoselect()
Dim Ftype1(3) As Integer
Dim Fdata1(3) As Variant
On Error Resume Next
Set sset = ThisDrawing.SelectionSets("sset2")
If Err <> 0 Then
Err.Clear
Set sset = ThisDrawing.SelectionSets.Add("sset2")
Else
sset.Clear
End If
Ftype1(0) = -4
Fdata1(0) = "<or"
Ftype1(1) = 0
Fdata1(1) = "TEXT"
Ftype1(2) = 0
Fdata1(2) = "MTEXT"
Ftype1(3) = -4
Fdata1(3) = "or>"
sset.SelectOnScreen Ftype1, Fdata1
End Sub

  • 2

#11 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 02 July 2012 - 10:12 AM

Cám ơn các bạn.
Mình mới code bằng VBA như sau:
Code chọn toàn bộ Text trên màn hình và đánh STT:

Sub Sort()
Dim fType(0) As Integer, fData(0)
Dim SSet As AcadSelectionSet
Dim Text As AcadText
Dim X() As Double
Dim i, n As Integer
Dim STT As Integer
STT = InputBox("Nhap so bat sau:", "Renumbering")
On Error Resume Next
Set SSet = ThisDrawing.SelectionSets("SSet")
If Err Then Set SSet = ThisDrawing.SelectionSets.Add("SSet")
SSet.Clear
fType(0) = 0: fData(0) = "Text"
SSet.Select acSelectionSetAll, , , fType, fData
i = 0
n = SSet.Count
ReDim X(1 To n)
'Sap xep tap doi tuong tang dan
For Each Text In SSet
i = i + 1
X(i) = Text.InsertionPoint(0)
Next
Dim j, k As Integer
Dim TG As Double
For j = 1 To n - 1
For k = j + 1 To n
If X(j) > X(k) Then
TG = X(j)
X(j) = X(k)
X(k) = TG
End If
Next
Next
'Hien thi danh STT len man hinh
For Each Text In SSet
For j = 1 To n
If Text.InsertionPoint(0) = X(j) Then
Text.TextString = j + STT - 1
End If
Next
Next
End Sub

  • 1