摘要:转自:http://www.programfan.com/article/3161.html
阅读全文
摘要:Dim dx As Double Dim dy As Double Dim arf As Double Dim m As Double Dim r(0 To 3, 0 To 3) As Double '旋转矩阵 r(0, 0) = m * Math.Cos(arf): r(0, 1) = -m * Math.Sin(arf): r(0, 2) = 0: r(0, 3) = dx r(1, 0) =
阅读全文
摘要:1 '定义过滤器 2 3 Dim pType, pData 4 5 6 7 'BuildFilter pType, pData, 0, "BlockReference", 8, "GCD", 62, 3 '建立图层是JZD?颜色为绿色的多段线过滤器 8 9 10 11 12 13 BuildFilter pType, pData, 8, "GCD" 14 15 '定义选择集 16 17 18 19
阅读全文
摘要:Dim files, path, filename path = ThisDrawing.Utility.GetString(True, "输入dwg文件所在路径:") 'dwg文件路径 If path = "" Then Return files = Dir(path & "*.dwg") Dim text As AcadText Do While files "" '打开dwg文件 ThisDrawing.Application.Documents.Open (path & ..
阅读全文
摘要:Private Sub CommandButton3_Click() Dim pInsertPnt As Variant 'pInsertPnt(0) = 100.5141: pInsertPnt(1) = 34.5034: pInsertPnt(2) = 0# UserForm1.Hide pInsertPnt = ThisDrawing.Utility.GetPoint(, "请输入点或者在屏幕上选择一点: ") Dim pBlock As AcadBlockReference Dim pBlockName As String Dim pXDataType(0
阅读全文
摘要:Dim pText As AcadText Dim pColor1 As AcadAcCmColor Set pColor1 = Application.GetInterfaceObject("AutoCAD.AcCmColor.16") Call pColor1.SetRGB(0, 0, 255) Dim pColor2 As AcadAcCmColor Set pColor2 = Application.GetInterfaceObject("AutoCAD.AcCmColor.16") Call pColor2.SetRGB(127, 0, 0)
阅读全文
摘要:Private Sub CommandButton11_Click() Dim pPoint As AcadPoint Dim DataType(0 To 1) As Integer Dim Data(0 To 1) As Variant Dim pLocation(0 To 2) As Double Dim sValue() As String Open "F:\2.txt" For Input As #1 DataType(0) = 1001: Data(0) = "gcz" Do While Not EOF(1) Line Input #1, sS
阅读全文
摘要:Private Sub CommandButton1_Click()Dim pEntity As AcadObjectDim pBlock As AcadBlockReferenceDim pPolyline As AcadLWPolylineDim pSlct As AcadSelectionSet'若Entity选择集存在,则删除选择集,删除后并添加For i = 0 To ThisDrawing.SelectionSets.Count - 1If ThisDrawing.SelectionSets.Item(i).Name = "Entity" ThenSet
阅读全文