Hỏi cách chèn block theo một line or pline cho trước

[nguyenthaodang 0]

Bài toán:

 

có 1 vòng tròn ( hoặc cung tròn cho truớc) Làm thế nào để có thể chèn block theo một tỉ lệ chia cho trước.

 

em đang bí ko nghĩ cách nào giải quyết được vấn đề này! xin mọi người giúp đỡ!

 

cảm ơn:

[sson 11]

Bài toán:

 

có 1 vòng tròn ( hoặc cung tròn cho truớc) Làm thế nào để có thể chèn block theo một tỉ lệ chia cho trước.

 

em đang bí ko nghĩ cách nào giải quyết được vấn đề này! xin mọi người giúp đỡ!

 

cảm ơn:

Có phải ý bạn là chèn các block cách đều nhau trên 1 cung tròn?

Bạn định làm một cung tròn cụ thể hay là một đoạn mã VBA có thể thực hiện được với bất cứ đường tròn hay cung tròn nào?

[nguyenthaodang 0]

Có phải ý bạn là chèn các block cách đều nhau trên 1 cung tròn?

Bạn định làm một cung tròn cụ thể hay là một đoạn mã VBA có thể thực hiện được với bất cứ đường tròn hay cung tròn nào?

 

em muốn viết một đoạn mã vba có thể thực hiện với bất kì một cung tròn nào đó^^ thank anh đã quan tâm tới.

 

khoảng cách đều xác định cho trước.

[nhatminhrd 3]

DIVIDE hoặc MEASURE không được àh???

 

Dùng DIVICE hay MEASURE là OK rồi.

Nói rõ hơn tí cho bạn í đỡ mất công tìm hỉu nhìu quá

 

1> MEASURE: Chèn theo khoảng cách cho trước hoặc pick 2 điểm

- Measure

- Click chọn vòng/cung tròn/...line, pline ,...

- Hỏi [block] ---> nhấn "B" ---> chọn block (viết tên block vào)

- Hỏi có quay block theo tiếp tuyến không <Y/N> tuỳ theo mục đích mà chọn Y hoặc N

- Chọn khoảng cách giữa các block, có thể pick 2 điểm

- XONG

>>>>> sẽ có khoảng thừa nếu bội của khoảng cách chèn ko bằng chiều dài đối tượng biên.

vd: biên là line có độ dài 10cm, khoảng cách chèn là 3cm thì chèn được 4 block và thừa lại 1 tí tẹo là 1cm.

 

2> DIVICE: Chèn theo số block --> khoảng cách sẽ được chia đều. n block và (n-1) đoạn.

Làm tương tự như MEASURE là OK.

 

(*) Đối với vòng tròn như bạn thì thử làm rồi kiểm tra điểm bắt đầu chèn block như thế nào nhé.

 

GODDLUCK

[nguyenthaodang 0]

thank mấy bác! nhưng em đang hỏi là code của VBA tự động thực hiện cơ ^^

[sson 11]

DIVIDE hoặc MEASURE không được àh???

Cảm ơn bác! em giờ mới biết 2 lệnh này, còn bác nguyenthaodang vẫn thích VBA thì có thể dùng lệnh sendcommand để sử dụng lệnh DIVIDE của cad.

Đây là đoạn code mới sưu tầm và sửa đôi chút:

Public Sub pratice()
Dim sset6 As AcadSelectionSet
Dim entry As AcadEntity
Dim myline As AcadLine
Dim myspline As AcadSpline
Dim mycircle As AcadCircle
Dim myarc As AcadArc

Dim myblockname As String
Dim numDivs As Long
numDivs = 6
myblockname = "aa"

ThisDrawing.Utility.Prompt ("Select lines, spline, circle, arc")
Set sset6 = ThisDrawing.SelectionSets.Add("SS1111111")
sset6.SelectOnScreen

For Each entry In sset6
Select Case entry.ObjectName
Case "AcDbLine"
Set myline = entry
ThisDrawing.SendCommand "._divide (handent """ & myline.Handle & """) "
Case "AcDbSpline"
Set myspline = entry
ThisDrawing.SendCommand "._divide (handent """ & myspline.Handle & """) "
Case "AcDbCircle"
Set mycircle = entry
ThisDrawing.SendCommand "._divide (handent """ & mycircle.Handle & """) "
Case "AcDbArc"
Set myarc = entry
ThisDrawing.SendCommand "._divide (handent """ & myarc.Handle & """) "
Case Else:
GoTo ends
End Select

ThisDrawing.SendCommand Format$("B") & " "
ThisDrawing.SendCommand Format$(myblockname) & " "
ThisDrawing.SendCommand Format$(Chr(10))
ThisDrawing.SendCommand Format$("Y")
ThisDrawing.SendCommand Format$(Chr(10))
ThisDrawing.SendCommand Format$(numDivs) & " "

ends:
Next entry

sset6.Delete
Set ss1111111 = Nothing


End Sub

[nguyenthaodang 0]

code trên rất là hay^^ mình đã test với line, spline, acr và cả circler đều được

 

mình có thêm lệnh để test với polyline thì lại bị lỗi. bro sson có thể check giùm được ko ạ

 

Case "AcDbPolyline"

Set mypolyline = entry

ThisDrawing.SendCommand "._divide (handent """ & mypolyline.Handle & """) "

 

mình có thêm trường hợp này để vẽ nhưng lại cứ báo lỗi là ko thấy block đâu???? xin giúp đỡ

[sson 11]

code trên rất là hay^^ mình đã test với line, spline, acr và cả circler đều được

 

mình có thêm lệnh để test với polyline thì lại bị lỗi. bro sson có thể check giùm được ko ạ

 

Case "AcDbPolyline"

Set mypolyline = entry

ThisDrawing.SendCommand "._divide (handent """ & mypolyline.Handle & """) "

 

mình có thêm trường hợp này để vẽ nhưng lại cứ báo lỗi là ko thấy block đâu???? xin giúp đỡ

:cheers:

Polyline hơi đặc biệt 1 chút, polyline thông thường hay vẽ là AcadLWPolyline

chắc là bạn khai báo Dim mypolyline As AcadPolyline

hãy chuyển thành Dim mypolyline As AcadLWPolyline