Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
3 replies to this topic

#1 minhthuc113

minhthuc113

    Chưa sử dụng CAD

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

Đã gửi 09 July 2014 - 08:46 AM

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

  • 0

#2 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 09 July 2014 - 10:36 AM

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

  • 0

#3 minhthuc113

minhthuc113

    Chưa sử dụng CAD

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

Đã gửi 10 July 2014 - 08:40 AM

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. :)


  • 0

#4 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 10 July 2014 - 09:02 AM

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


  • 0