Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
minhthuc113

giúp đỡ khai báo Dim bằng VBA cho hình vuông trong cad2007

Bởi minhthuc113 , trong Lập trình khác

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

minhthuc113    0

minhthuc113
Đã đăng

mình đã dùng dòng lệnh VBA bên dưới để vẽ hình vuông thông qua việc nhập giá trị kích thước trong hộp thoại textbox. Mình cũng đã mấy ngày liền tìm hiểu nhiều tài liệu để viết VBA tự động Dim kích thước cho từng cạnh của hình vuông đó, kèm theo vẽ thêm 1 hình vuông nhỏ nữa nằm trong hình vuông khai báo nhưng đều thất bại  :) . Vậy, mong ae có thể chỉ giáo cho mình vấn đề này được không?. :)

Private Sub CommandButton1_Click()
Dim pt1 As Variant
Dim pt2 As Variant
Dim pt3 As Variant
Dim pt4 As Variant
Dim pi As Double
pi = 3.14159265358979
UserForm1.Hide
pt1 = ThisDrawing.Utility.GetPoint(, "chon diem goc:")
pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, Val(TextBox1.Text))
pt3 = ThisDrawing.Utility.PolarPoint(pt2, pi / 2, Val(TextBox2.Text))
pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, Val(TextBox2.Text))
ThisDrawing.ModelSpace.AddLine pt1, pt2
ThisDrawing.ModelSpace.AddLine pt2, pt3
ThisDrawing.ModelSpace.AddLine pt3, pt4
ThisDrawing.ModelSpace.AddLine pt4, pt1
ZoomAll

End Sub

 

Private Sub CommandButton1_Click()
Dim pt1 As Variant
Dim pt2 As Variant
Dim pt3 As Variant
Dim pt4 As Variant
Dim pi As Double
pi = 3.14159265358979
UserForm1.Hide
pt1 = ThisDrawing.Utility.GetPoint(, "chon diem goc:")
pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, Val(TextBox1.Text))
pt3 = ThisDrawing.Utility.PolarPoint(pt2, pi / 2, Val(TextBox2.Text))
pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, Val(TextBox2.Text))
ThisDrawing.ModelSpace.AddLine pt1, pt2
ThisDrawing.ModelSpace.AddLine pt2, pt3
ThisDrawing.ModelSpace.AddLine pt3, pt4
ThisDrawing.ModelSpace.AddLine pt4, pt1
ZoomAll
 
End Sub
Private Sub CommandButton1_Click()
Dim pt1 As Variant
Dim pt2 As Variant
Dim pt3 As Variant
Dim pt4 As Variant
Dim pi As Double
pi = 3.14159265358979
UserForm1.Hide
pt1 = ThisDrawing.Utility.GetPoint(, "chon diem goc:")
pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, Val(TextBox1.Text))
pt3 = ThisDrawing.Utility.PolarPoint(pt2, pi / 2, Val(TextBox2.Text))
pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, Val(TextBox2.Text))
ThisDrawing.ModelSpace.AddLine pt1, pt2
ThisDrawing.ModelSpace.AddLine pt2, pt3
ThisDrawing.ModelSpace.AddLine pt3, pt4
ThisDrawing.ModelSpace.AddLine pt4, pt1
ZoomAll
 
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

gia_bach    1.549

gia_bach
Đã đăng

 

mình đã dùng dòng lệnh VBA bên dưới để vẽ hình vuông thông qua việc nhập giá trị kích thước trong hộp thoại textbox. Mình cũng đã mấy ngày liền tìm hiểu nhiều tài liệu để viết VBA tự động Dim kích thước cho từng cạnh của hình vuông đó, kèm theo vẽ thêm 1 hình vuông nhỏ nữa nằm trong hình vuông khai báo nhưng đều thất bại  :) . Vậy, mong ae có thể chỉ giáo cho mình vấn đề này được không?. :)

Private Sub CommandButton1_Click()
Dim pt1 As Variant
Dim pt2 As Variant
Dim pt3 As Variant
Dim pt4 As Variant
Dim pi As Double
pi = 3.14159265358979
UserForm1.Hide
pt1 = ThisDrawing.Utility.GetPoint(, "chon diem goc:")
pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, Val(TextBox1.Text))
pt3 = ThisDrawing.Utility.PolarPoint(pt2, pi / 2, Val(TextBox2.Text))
pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, Val(TextBox2.Text))
ThisDrawing.ModelSpace.AddLine pt1, pt2
ThisDrawing.ModelSpace.AddLine pt2, pt3
ThisDrawing.ModelSpace.AddLine pt3, pt4
ThisDrawing.ModelSpace.AddLine pt4, pt1
ZoomAll

End Sub

 

Private Sub CommandButton1_Click()
Dim pt1 As Variant
Dim pt2 As Variant
Dim pt3 As Variant
Dim pt4 As Variant
Dim pi As Double
pi = 3.14159265358979
UserForm1.Hide
pt1 = ThisDrawing.Utility.GetPoint(, "chon diem goc:")
pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, Val(TextBox1.Text))
pt3 = ThisDrawing.Utility.PolarPoint(pt2, pi / 2, Val(TextBox2.Text))
pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, Val(TextBox2.Text))
ThisDrawing.ModelSpace.AddLine pt1, pt2
ThisDrawing.ModelSpace.AddLine pt2, pt3
ThisDrawing.ModelSpace.AddLine pt3, pt4
ThisDrawing.ModelSpace.AddLine pt4, pt1
ZoomAll
 
End Sub
Private Sub CommandButton1_Click()
Dim pt1 As Variant
Dim pt2 As Variant
Dim pt3 As Variant
Dim pt4 As Variant
Dim pi As Double
pi = 3.14159265358979
UserForm1.Hide
pt1 = ThisDrawing.Utility.GetPoint(, "chon diem goc:")
pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, Val(TextBox1.Text))
pt3 = ThisDrawing.Utility.PolarPoint(pt2, pi / 2, Val(TextBox2.Text))
pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, Val(TextBox2.Text))
ThisDrawing.ModelSpace.AddLine pt1, pt2
ThisDrawing.ModelSpace.AddLine pt2, pt3
ThisDrawing.ModelSpace.AddLine pt3, pt4
ThisDrawing.ModelSpace.AddLine pt4, pt1
ZoomAll
 
End Sub

Hình như chủ thớt vẽ hình chữ nhật, không phải vẽ hình vuông vì dùng 2 TextBox để lưu 2 giá trị khác nhau.

Tham khảo code vẽ đường kích thước của hình chữ nhật.

Private Sub DimHCN()
    Dim pt1 As Variant
    Dim pt2 As Variant
    Dim pt3 As Variant
    Dim pt4 As Variant
    Dim pi As Double
    pi = 3.14159265358979
    
    Dim rong As Double
    Dim dai As Double
    rong = 5
    dai = 10
    'UserForm1.Hide
    pt1 = ThisDrawing.Utility.GetPoint(, "chon diem goc:")
    pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, dai)
    pt3 = ThisDrawing.Utility.PolarPoint(pt2, pi / 2, rong)
    pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, rong)
    ThisDrawing.ModelSpace.AddLine pt1, pt2
    ThisDrawing.ModelSpace.AddLine pt2, pt3
    ThisDrawing.ModelSpace.AddLine pt3, pt4
    ThisDrawing.ModelSpace.AddLine pt4, pt1
    
    Dim dis As Double
    dis = 1
    
    Dim ptTxt As Variant
    ptTxt = ThisDrawing.Utility.PolarPoint(pt1, pi / -2, dis)
    ThisDrawing.ModelSpace.AddDimAligned pt1, pt2, ptTxt
    
    ptTxt = ThisDrawing.Utility.PolarPoint(pt2, 0, dis)
    ThisDrawing.ModelSpace.AddDimAligned pt2, pt3, ptTxt
    
    ptTxt = ThisDrawing.Utility.PolarPoint(pt3, pi / 2, dis)
    ThisDrawing.ModelSpace.AddDimAligned pt3, pt4, ptTxt
    
    ptTxt = ThisDrawing.Utility.PolarPoint(pt4, 0, -dis)
    ThisDrawing.ModelSpace.AddDimAligned pt4, pt1, ptTxt
    'ZoomAll

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

minhthuc113    0

minhthuc113
Đã đăng

thanks gia_bach nhiều nha :). Nhưng lỡ giúp thì giúp cho chốt :), gia_bach có thể hưởng dẫn mình vẽ thêm cái hình vuông (chữ nhật) nhỏ nằm bên trong được không? ( nếu nó là đường polyline càng tốt). Do tài liệu mình tìm hiểu còn nhiều hạn chế quá, sách chỉ hướng dẫn mình viết mã VBA để tạo và hiệu chỉnh 1 object đơn, chứ không hướng dẫn mình kết hợp các mã VBA đó lại nên hơi khó để đi sâu mà phát triển. :)

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

gia_bach    1.549

gia_bach
Đã đăng

thanks gia_bach nhiều nha :). Nhưng lỡ giúp thì giúp cho chốt :), gia_bach có thể hưởng dẫn mình vẽ thêm cái hình vuông (chữ nhật) nhỏ nằm bên trong được không? ( nếu nó là đường polyline càng tốt). Do tài liệu mình tìm hiểu còn nhiều hạn chế quá, sách chỉ hướng dẫn mình viết mã VBA để tạo và hiệu chỉnh 1 object đơn, chứ không hướng dẫn mình kết hợp các mã VBA đó lại nên hơi khó để đi sâu mà phát triển. :)

1.Nhưng lỡ giúp thì giúp cho chốt : Thiên hạ đã có 4 cái "NGU", giờ thêm 1 cái NGU mới à?! :mellow: biết bao giờ mới "chốt"?

 

2. vẽ thêm cái hình vuông (chữ nhật) nhỏ nằm bên trong được không? : hiểu chết liền...

 

3. đường polyline :  

Sub Example_AddLightWeightPolyline()
    ' This example creates a lightweight polyline in model space.
    
    Dim plineObj As AcadLWPolyline
    Dim points(0 To 9) As Double
    
    ' Define the 2D polyline points
    points(0) = 1: points(1) = 1
    points(2) = 1: points(3) = 2
    points(4) = 2: points(5) = 2
    points(6) = 3: points(7) = 2
    points(8) = 4: points(9) = 4
        
    ' Create a lightweight Polyline object in model space
    Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    ZoomAll
    
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  
Người theo dõi 0
Về Đầu Trang Lập trình khác
×