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?

[ptlong04x1 8]

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!

[thanhduan2407 276]

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.

[thanhduan2407 276]

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.com/file/8eM-k9Jn/od_oc...u_tu_tang_.html

[Tue_NV 3915]

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.com/file/8eM-k9Jn/od_oc...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!

[Jin Yong 337]

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?

[anhcos 196]

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.

[thanhduan2407 276]

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

[NguyenNgocSon 43]

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 !

[NguyenNgocSon 43]

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!

[garupro 7]

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

[NguyenNgocSon 43]

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

[Phạm Minh Quân 0]

Vào lúc 2/7/2012 tại 10:12, NguyenNgocSon đã nói:

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:

 

• cadvietlisp.lsp
  
• [✎]
   

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

 

 

Bạn đúng là siêu