yswu 发表于 2004-3-29 14:24:00

怎么用呀

CQBOY 发表于 2004-3-31 20:32:00

下面的代码是我借鉴前面的代码编写的，但是为什么有些代码不能执行呢？


Dim etobj As EFCAD.Table<BR>Sub ZBBG()                                                                                                                                                                                        <BR>                       '创建名为"坐标表格"的新图层<BR>                       Dim layerObj As AcadLayer<BR>                       Set layerObj = ThisDrawing.Layers.Add("坐标表格")<BR>                       layerObj.Color = acRed<BR>'设置为当前图层<BR>                       Dim newlayer As AcadLayer<BR>                       Set newlayer = ThisDrawing.Layers("坐标表格")<BR>                       ThisDrawing.ActiveLayer = newlayer


                       Dim ZBBG As AcadTextStyle                       '文字样式<BR>                       Set ZBBG = ThisDrawing.TextStyles.Add("ZBBG") '设定文字样式<BR>                       Set ZBBG = ThisDrawing.ActiveTextStyle<BR>                       ZBBG.BigFontFile = "hztxt1.shx"<BR>                        'ZBBG.FontFile = "c:\windows\fonts\simsun.ttf"                                                                                                                '        这行代码不能执行<BR>                       Dim ipt As Variant<BR>                       Dim entobj As AcadEntity<BR>                       Dim pts As Variant<BR>                       Dim i As Integer                                <BR>                       On Error GoTo err<BR>                       Set etobj = New EFCAD.Table<BR>                       Set etobj.Application = Application<BR>                       etobj.DisplayHeadings False                                                                                                                                               '        这行代码不能执行<BR>                       ipt = etobj.GetPoint(, "指定表格的插入点：")<BR>                       If IsEmpty(ipt) Then Exit Sub<BR>                       '在ipt点生成1行3列，方向从上到下的表格，默认行高为5，列宽为30<BR>                       etobj.AddTable ipt, 1, 6, 1, 5, 30<BR>                       '设置1行1列的值为“点号”，以下同<BR>                       etobj.Range("A1").Value = "点号"<BR>                       etobj.Range("B1").Value = "桩形"<BR>                       etobj.Range("C1").Value = "X（m）"<BR>                       etobj.Range("D1").Value = "Y（m）"<BR>                       etobj.Range("E1").Value = "高程"<BR>                       etobj.Range("F1").Value = "备注"<BR>                       '设置1行的文字对齐方式为正中对齐<BR>                       'etobj.Range("A1:C1").Alignment = 5                                                                                                                                                               '        这行代码不能执行<BR>                       Set entobj = etobj.GetEntity(, "选择对象：")<BR>                       Do While Not (entobj Is Nothing)<BR>                                               pts = entobj.Coordinates<BR>                                               For i = 0 To UBound(pts) Step 50<BR>                                               '在表格中插入1行<BR>                                                                               etobj.AddRow etobj.Rows.Count + 1<BR>                                                                               etobj.Cells(etobj.Rows.Count, 1).Value = etobj.Rows.Count - 1<BR>                                                                               etobj.Cells(etobj.Rows.Count, 3).Value = Round(pts(i), 3)<BR>                                                                               etobj.Cells(etobj.Rows.Count, 4).Value = Round(pts(i + 1), 3)<BR>                                               Next<BR>                                                                               Set entobj = etobj.GetEntity(, "选择对象：")<BR>                       Loop<BR>                       'etobj.Range("A1:F" &amp; etobj.Rows.Count).Alignment = 5                                               '        这行代码不能执行<BR>                       ThisDrawing.Regen acActiveViewport<BR>                       Set entobj = Nothing<BR>                       Set etobj = Nothing<BR>                       Exit Sub                                       <BR>err:<BR>On Error GoTo 0<BR>End Sub

文字文字

leer 发表于 2004-7-26 23:37:00

不知道有什么用，其实用truetanble之类的东西就能把cad的表格很好的处理，这里生成的表格不能很方便的操作，实用起来困难啊，不过，确实是个不错的东西。

pppk 发表于 2004-7-29 15:14:00

请问各位版主，我何时才有浏览精华帖子的权限？

阿笨狼 发表于 2004-7-30 20:44:00

很好

leer 发表于 2004-8-18 18:31:00

用了一下，觉得做得好，可是不实用

hiperin 发表于 2011-5-25 13:54:25

太好了!找了好久了

雁苍山下人 发表于 2019-4-30 01:01:31

zzyong00 发表于 2019-4-30 13:01:48

多少年前的老贴子，今日有幸拜读，荣幸之至！
作者应该是重新定义一些接口了，虽然没有帮助文档，但顾思义，也能看懂！
页: 1 2 [3]
查看完整版本: [测试]：AutoCAD表格制作工具的接口