本帖最后由 dage23wo 于 2015-7-14 16:48 编辑
- Private Sub CommandButton1_Click()
- Dim PtPick As Variant
- UserForm1.hide
- PtPick = ThisDrawing.Utility.GetPoint(, "请在屏幕上选择起点:")
- TextBox1.Text = PtPick(0)
- TextBox2.Text = PtPick(1)
- UserForm1.Show
- Dim blk As IAcadBlockReference2
- Dim ent As AcadEntity
- Dim pnt As Variant
-
- If ent.ObjectName = "立柱" Then
- Set blk = ent
- Else
- Exit Sub
- End If
-
- Dim dyBlkPropCol As Variant ' 自定义特性的集合
- Dim dyBlkProp As AcadDynamicBlockReferenceProperty ' 自定义特性
-
- Dim i As Long
-
- If blk.IsDynamicBlock Then
- ' 获得动态块的自定义特性
- dyBlkPropCol = blk.GetDynamicBlockProperties
-
-
-
- For i = 0 To UBound(dyBlkPropCol)
- Set DBlockProperties = dyBlkPropCol(i)
- With DBlockProperties
- If .PropertyName = "距离" Then
- .Value = CDbl(TextBox3.Text)
- Exit For
- End If
- End With
- Next i
-
- End If
-
- Dim ptInsert(0 To 2) As Double
- ptInsert(0) = TextBox1.Text: ptInsert(1) = TextBox2.Text: ptInsert(2) = 0
- Set blk = ThisDrawing.ModelSpace.InsertBlock(ptInsert, "立柱", 1, 1, 1, 0)
- ZoomAll
-
-
-
- End Sub
|