Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
MinhTri782015

sửa lỗi code vba trong autocad

Các bài được khuyến nghị

xin cac cao nhân chỉ giáo, sửa giúp cái code, tại sao nó chỉ chọn một là dim hai là text. mà ko thay đổi tất cả trong cùng một selectionset

 

Public Sub S1() 'chosing the dimstyle follow the frame block

'choose the frame block to use the scale factor

Dim Object As AcadBlockReference

Dim sset2 As AcadSelectionSet

Dim a As Double

Dim Ent As AcadEntity

Dim P1 As AcadDimension

Dim P4 As AcadLeader

 

On Error Resume Next

ThisDrawing.SelectionSets("ml2").Delete

Set sset2 = ThisDrawing.SelectionSets.Add("ml2")

sset2.SelectOnScreen

For Each Object In sset2

a = Object.XScaleFactor

Next

 

Dim string1 As String

Dim objdimstyle As AcadDimStyle

'choose the dimstyle

 

'CHOOSE the Mtext to changing height text

Dim GpCode(5) As Integer

Dim dataValue(5) As Variant

 

GpCode(0) = -4: dataValue(0) = "<or"

GpCode(1) = 0: dataValue(1) = "MTEXT"

GpCode(2) = 0: dataValue(2) = "TEXT"

GpCode(3) = 0: dataValue(3) = "DIMENSION"

GpCode(4) = 0: dataValue(4) = "LEADER"

 

GpCode(5) = -4: dataValue(5) = "or>"

 

Dim sset21 As AcadSelectionSet

On Error Resume Next

ThisDrawing.SelectionSets("ml21").Delete

Set sset21 = ThisDrawing.SelectionSets.Add("ml21")

sset21.SelectOnScreen GpCode, dataValue

 

On Error Resume Next

 

For Each Ent In sset21

 Ent.Height = 2 * a

 

Next

string1 = "A3S " & a

 

For Each objdimstyle In ThisDrawing.DimStyles

If string1 = objdimstyle.Name Then

 

 

'ThisDrawing.ActiveDimStyle = ThisDrawing.DimStyles(string1)

 

For Each P1 In sset21

P1.StyleName = string1

 

Next

 

For Each P4 In sset21

P4.StyleName = string1

Next

Exit Sub

End If

Next

Set objdimstyle = ThisDrawing.DimStyles.Add(string1)

ThisDrawing.SetVariable "dimscale", a

objdimstyle.CopyFrom ThisDrawing

'ThisDrawing.ActiveDimStyle = ThisDrawing.DimStyles(string1)

 

For Each P1 In sset21

P1.StyleName = string1

Next

 

For Each P4 In sset21

P4.StyleName = string1

Next

 

End Sub

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×