[编程申请]：各位兄弟，看看这个功能怎么做？(上次没人回应）

xxming · 发表于 2003-9-14 19:41:17

谢了，楼上兄弟，我等你上传程序。

efan2000 · 发表于 2003-9-14 19:49:35

是要达到这种效果吗？

efan2000 · 发表于 2003-9-14 20:04:25

使用了自已编写的表格制作组件。
在“工具”——“引用”中加载EFTable.dll组件。

[FONT=courier new]
Dim etObj As EFCAD.Table
'创建表格并选择要输入坐标的对象
Sub test()
Dim iPt As Variant
Dim EntObj As AcadEntity
Dim Pts As Variant
Dim i As Integer
On Error GoTo ErrTrap
Set etObj = New EFCAD.Table
Set etObj.Application = Application
iPt = etObj.GetPoint(, "指定表格的插入点: ")
If IsEmpty(iPt) Then Exit Sub
'在iPt点生成1行3列，方向从上到下的表格，默认行高为5，列宽为30
etObj.AddTable iPt, 1, 3, 1, 5, 30
'设置1行1列的值为“角点”，以下同
etObj.Range("A1").Text = "角点"
etObj.Range("B1").Text = "X坐标"
etObj.Range("C1").Text = "Y坐标"
'设置1行的文字对齐方式为正中对齐
etObj.Range("A1:C1").Alignment = 5
Set EntObj = etObj.GetEntity(, "选择对象: ")
Do While Not (EntObj Is Nothing)
Pts = EntObj.Coordinates
For i = 0 To UBound(Pts) Step 2
'在表格中插入1行
etObj.AddRow etObj.Rows.Count + 1
etObj.Cells(etObj.Rows.Count, 1).Text = etObj.Rows.Count - 1
etObj.Cells(etObj.Rows.Count, 2).Text = Round(Pts(i) + 0.0000000001, 4)
etObj.Cells(etObj.Rows.Count, 3).Text = Round(Pts(i + 1) + 0.0000000001, 4)
Next
Set EntObj = etObj.GetEntity(, "选择对象: ")
Loop
etObj.Range("A1:C" & etObj.Rows.Count).Alignment = 5
ThisDrawing.Regen acActiveViewport
Set EntObj = Nothing
Set etObj = Nothing
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
[/FONT]

[FONT=courier new] 
Dim etObj As EFCAD.Table 
 
'创建表格并选择要输入坐标的对象 
Sub test() 
    Dim iPt As Variant 
    Dim EntObj As AcadEntity 
    Dim Pts As Variant 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    Set etObj = New EFCAD.Table 
    Set etObj.Application = Application 
    iPt = etObj.GetPoint(, "指定表格的插入点: ") 
    If IsEmpty(iPt) Then Exit Sub 
    '在iPt点生成1行3列，方向从上到下的表格，默认行高为5，列宽为30 
    etObj.AddTable iPt, 1, 3, 1, 5, 30 
    '设置1行1列的值为“角点”，以下同 
    etObj.Range("A1").Text = "角点" 
    etObj.Range("B1").Text = "X坐标" 
    etObj.Range("C1").Text = "Y坐标" 
    '设置1行的文字对齐方式为正中对齐 
    etObj.Range("A1:C1").Alignment = 5 
    Set EntObj = etObj.GetEntity(, "选择对象: ") 
    Do While Not (EntObj Is Nothing) 
        Pts = EntObj.Coordinates 
        For i = 0 To UBound(Pts) Step 2 
            '在表格中插入1行 
            etObj.AddRow etObj.Rows.Count + 1 
            etObj.Cells(etObj.Rows.Count, 1).Text = etObj.Rows.Count - 1 
            etObj.Cells(etObj.Rows.Count, 2).Text = Round(Pts(i) + 0.0000000001, 4) 
            etObj.Cells(etObj.Rows.Count, 3).Text = Round(Pts(i + 1) + 0.0000000001, 4) 
        Next 
        Set EntObj = etObj.GetEntity(, "选择对象: ") 
    Loop 
    etObj.Range("A1:C" & etObj.Rows.Count).Alignment = 5 
    ThisDrawing.Regen acActiveViewport 
    Set EntObj = Nothing 
    Set etObj = Nothing 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
  [/FONT]

fools · 发表于 2003-9-14 22:21:57

16楼的兄弟，我调整了一下程序，你再试试，有什么问题的话再告诉我

(deleted!

复制代码

xxming · 发表于 2003-9-15 10:10:31

太谢谢你楼上兄弟辛苦了，我正是想得到这种效果，以后能给图加个编号就更好了。问个问题这个程序能否加入晓东工具箱？

fools · 发表于 2003-9-15 21:52:47

楼上的兄弟不用客气，我的程序写的太业余了
不过这个功能确实很有用，我自己也在用，不过我用的和贴出来的略微有所不同，我是把天正生成的坐标块变成表格

xxming · 发表于 2003-9-16 10:05:01

FOOLS兄我提个见意，我的图有的座标点很多，表格排起来有时很长，你能否设个功能，使表格能够排成二排或多排的功能。希望你能更好地完善该的程序。

fools · 发表于 2003-9-16 20:49:23

最初由 xxming 发布
[B]FOOLS兄我提个见意，我的图有的座标点很多，表格排起来有时很长，你能否设个功能，使表格能够排成二排或多排的功能。希望你能更好地完善该的程序。 [/B]

多谢你的建议和支持，我会尽力把程序变的更完善
有了新程序我会在这贴出

沉羽 · 发表于 2003-9-17 14:27:52

哎我的邮箱weiping8035-cn@163.com 我好象有你说的这个工具不过是韩文的...希望对你有用

xxming · 发表于 2003-9-17 14:51:43

24楼楼主能否传上来或我的邮件
diablo_xie@yahoo.com.cn

沉羽 · 发表于 2003-9-17 15:06:02

sorry 我无法分开程序你加我QQ 54301 因为太大了我没办法发给你用QQ传吧

账号		自动登录	找回密码
密码			立即注册