Đến nội dung


Hình ảnh
- - - - -

Help về toạ độ 3D sang 2D bằng VBA


  • Please log in to reply
4 replies to this topic

#1 conghoangxd037

conghoangxd037

    biết vẽ line

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

Đã gửi 17 January 2013 - 01:50 PM

Hiện trên bản vẽ em các đường line có toạ độ 3D X,Y,Z( mà Z thì không phải bằng 0) làm thế nào chuyển tất cả các đường line trên bản vẽ về toạ độ 2D X, Y(như cũ) nhưng Z=0.
  • 0

#2 Mọt Sách

Mọt Sách

    biết zoom

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

Đã gửi 17 January 2013 - 05:27 PM

Bạn tìm lisp là phẳng đối tượng là OK đấy mà
  • 0

#3 conghoangxd037

conghoangxd037

    biết vẽ line

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

Đã gửi 18 January 2013 - 07:32 AM

đúng là có lệnh chuyển đối tượng về z=0 nhưng sau khi sử dụng lệnh Flatten thì các đối tượng line sẽ thay đổi về thứ tự trong selection.Giống như em lập trình vba vẽ các đối tượng sẽ sử dụng lấy điểm endpoint, startpoint và cho z=0 thì cũng giống như lệnh flatten. Em muốn là mình chỉ chỉnh trong property thôi để trật tự vị trí xuất hiện đối tượng đầu và đối tượng cuối trong bản vẽ là cố định.Nếu dùng tay chỉ trong property thì hơi lâu, em thì muốn biết trong vba có phương pháp nào chỉ trong property không
  • 0

#4 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 18 January 2013 - 08:37 AM

đúng là có lệnh chuyển đối tượng về z=0 nhưng sau khi sử dụng lệnh Flatten thì các đối tượng line sẽ thay đổi về thứ tự trong selection.Giống như em lập trình vba vẽ các đối tượng sẽ sử dụng lấy điểm endpoint, startpoint và cho z=0 thì cũng giống như lệnh flatten. Em muốn là mình chỉ chỉnh trong property thôi để trật tự vị trí xuất hiện đối tượng đầu và đối tượng cuối trong bản vẽ là cố định.Nếu dùng tay chỉ trong property thì hơi lâu, em thì muốn biết trong vba có phương pháp nào chỉ trong property không

Tham khảo :

Sub LineTo2D()

Dim entry As AcadObject
Dim PickedPoint As Variant

ThisDrawing.Utility.GetEntity entry, PickedPoint, "(Select Line : )"

' Neu la doi tuong Line
If entry.ObjectName = "AcDbLine" Then
Dim line As AcadLine
Dim staPt As Variant
Dim endPt As Variant
Set line = entry
' Get StartPoint and EndPoint
staPt = line.StartPoint
endPt = line.EndPoint

' Set Z = 0
staPt(2) = 0
endPt(2) = 0

' Update Line with Z = 0
line.StartPoint = staPt
line.EndPoint = endPt

End If

End Sub


  • 1

#5 Mọt Sách

Mọt Sách

    biết zoom

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

Đã gửi 18 January 2013 - 08:47 AM

đúng là có lệnh chuyển đối tượng về z=0 nhưng sau khi sử dụng lệnh Flatten thì các đối tượng line sẽ thay đổi về thứ tự trong selection.Giống như em lập trình vba vẽ các đối tượng sẽ sử dụng lấy điểm endpoint, startpoint và cho z=0 thì cũng giống như lệnh flatten. Em muốn là mình chỉ chỉnh trong property thôi để trật tự vị trí xuất hiện đối tượng đầu và đối tượng cuối trong bản vẽ là cố định.Nếu dùng tay chỉ trong property thì hơi lâu, em thì muốn biết trong vba có phương pháp nào chỉ trong property không


Bạn tham khảo nhé :

Private sset As AcadSelectionSet
Private returnObj As ACADObject
Private elem As Object
Private color As Variant
Private Elv As Double
Private Layer As String
'--------------------------------
Private Sub cmdCancelM_Click()
On Error Resume Next
sset.Clear
Unload Me
End Sub
'--------------------------------
Private Sub Cmd_Select_Click()
Dim basePnt As Variant
Dim Elv As Double
Frm_UtilitiesPL.Hide

On Error Resume Next
ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select a polyline"

If (StrComp(returnObj.EntityName, "AcDbPolyline", 1) <> 0 And (StrComp(returnObj.EntityName, "AcDb2DPolyline", 1) <> 0)) Then
MsgBox "You did not select a polyline"
GoTo 1:
End If

Elv = returnObj.Elevation
Text_ELVcurent.Text = CStr(Elv)
TxT_LayerCurent.Text = returnObj.Layer
1:
Frm_UtilitiesPL.show

End Sub
'--------------------------------
Private Sub cmdApply_Click()
Dim Msbox
Dim elem1 As Object
Dim color1 As Variant
Dim ELV1 As Double
Dim Layer1 As String
Sub Gangiatri()
On Error Resume Next
'Thay doi cao doi
If Check_ELV.value = True Then
If Op_Change.value = True Then
elem.Elevation = elem.Elevation + Elv
End If
If Op_Fix.value = True Then
elem.Elevation = Elv
End If
End If
ELV1 = 0
If Check_ELV2.value = True Then
On Error Resume Next
ELV1 = CDbl(Txt_ELV2.Text)
End If
If Cbb_Layer2.value <> "Select Layer" Then
Layer1 = Cbb_Layer2.value
End If

' Gan cao do moi cho doi tuong
If Check_ELV2.value = True Then
If Op_Change2.value = True Then
returnObj.Elevation = returnObj.Elevation + ELV1
End If
If Op_Fix2.value = True Then
returnObj.Elevation = ELV1
End If
End If

  • 0