随笔分类 -  AutoCAD

摘要:转自:http://www.programfan.com/article/3161.html 阅读全文

posted @ 2019-12-12 11:41 Lzhm216 阅读(1439) 评论(0) 推荐(0)

摘要: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) = 阅读全文

posted @ 2019-12-12 11:39 Lzhm216 阅读(406) 评论(0) 推荐(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 阅读全文

posted @ 2019-12-12 11:37 Lzhm216 阅读(525) 评论(0) 推荐(0)

摘要: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 & .. 阅读全文

posted @ 2013-12-24 17:16 Lzhm216 阅读(952) 评论(0) 推荐(0)

摘要: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 阅读全文

posted @ 2013-07-08 23:45 Lzhm216 阅读(367) 评论(0) 推荐(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) 阅读全文

posted @ 2013-07-08 23:44 Lzhm216 阅读(956) 评论(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 阅读全文

posted @ 2013-07-07 21:50 Lzhm216 阅读(409) 评论(0) 推荐(0)

摘要: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 阅读全文

posted @ 2013-07-05 18:37 Lzhm216 阅读(1295) 评论(0) 推荐(0)

导航