[求助]：模仿TSSD1.7的表格编程，遇到了问题

追日

大家好，我刚接触CAD二次开发，模仿TSSD1.7，用delphi编了一个表格程序，遇到一些问题，请大家指教！如下图，如果要在表格里任意一个单元格点击，便可输入文字，但如何使输入的文字自动在各自的单元格里居中，也就是说怎样找出每个单元格的中心点？？
象TSSD1.7一样

efan2000

单元格的中心点应该由它外围的直线来定的，因而转化为求直线，可以使用射线法，即往四个方向各做一条射线，最先与它相交的就是所求的直线，然后求出它们的交点，交点一确定，中心点也就出来了。
还要一种方法是使用Boundry，求出包含点的外围，但是要用到ACAD的内部命令。

fjw_ok

请班长讲下射线法的方法好吗      ？？

追日

是啊，版主能将用例子现场教学一下吗？求单元格的中心点，我按您的提示，想了好几天，一直没有眉目，还请版主大人赐教！！！这种方法如果掌握了，我觉得可以应用到很多地方

efan2000

首先选择所有的直线，依次生成东、北、西、南的射线，求与直线的交点。

2. 
   
3.   [FONT=courier new]
   
4. Sub test()
   
5.     Const PI = 3.1415926
   
6.    
   
7.     On Error Resume Next
   
8.     ' 创建选择集
   
9.     Dim SSetObj As Object
   
10.     Set SSetObj = ThisDrawing.SelectionSets("SSET")
    
11.     If Err.Number <> 0 Then
    
12.         Err.Clear
    
13.         Set SSetObj = ThisDrawing.SelectionSets.Add("SSET")
    
14.     End If
    
15.     SSetObj.Clear
    
16.    
    
17.     On Error GoTo ErrTrap
    
18.     '创建过滤机制
    
19.     Dim fType(0 To 0) As Integer
    
20.     Dim fData(0 To 0) As Variant
    
21.     fType(0) = 0: fData(0) = "LINE"
    
22.    
    
23.     '选择所有直线
    
24.     SSetObj.Select acSelectionSetAll, , , fType, fData
    
25.    
    
26.     ' 选择点
    
27.     Dim Pt As Variant
    
28.     Pt = ThisDrawing.Utility.GetPoint(, "指定单元格内的一点: ")
    
29.    
    
30.     ' 确定射线的另一点（两点定出方向，这里是东向）
    
31.     Dim tPt As Variant
    
32.     tPt = ThisDrawing.Utility.PolarPoint(Pt, 0, 1)
    
33. 
    
34.     ' 创建射线
    
35.     Dim RayObj As AcadRay
    
36.     Set RayObj = ThisDrawing.ModelSpace.AddRay(Pt, tPt)
    
37.    
    
38.     Dim MaxX As Double
    
39.     MaxX = 99999999
    
40.     Dim EntObj As AcadEntity
    
41.     Dim v As Variant
    
42.     ' 枚举选择集
    
43.     For Each EntObj In SSetObj
    
44.         v = EntObj.IntersectWith(RayObj, acExtendNone)
    
45.         ' 直线与射线相交
    
46.         If Not IsEmpty(v) Then
    
47.             If UBound(v) > 0 Then If v(0) <= MaxX Then MaxX = v(0)
    
48.         End If
    
49.     Next
    
50.     RayObj.Delete
    
51.    
    
52.     ' 确定射线的另一点（两点定出方向，这里是北向）
    
53.     tPt = ThisDrawing.Utility.PolarPoint(Pt, PI / 2, 1)
    
54. 
    
55.     ' 创建射线
    
56.     Set RayObj = ThisDrawing.ModelSpace.AddRay(Pt, tPt)
    
57.    
    
58.     Dim MaxY As Double
    
59.     MaxY = 99999999
    
60.     ' 枚举选择集
    
61.     For Each EntObj In SSetObj
    
62.         v = EntObj.IntersectWith(RayObj, acExtendNone)
    
63.         ' 直线与射线相交
    
64.         If Not IsEmpty(v) Then
    
65.             If UBound(v) > 0 Then If v(1) <= MaxY Then MaxY = v(1)
    
66.         End If
    
67.     Next
    
68.     RayObj.Delete
    
69.    
    
70.     ' 确定射线的另一点（两点定出方向，这里是西向）
    
71.     tPt = ThisDrawing.Utility.PolarPoint(Pt, PI, 1)
    
72. 
    
73.     ' 创建射线
    
74.     Set RayObj = ThisDrawing.ModelSpace.AddRay(Pt, tPt)
    
75.    
    
76.     Dim MinX As Double
    
77.     MinX = -99999999
    
78.     ' 枚举选择集
    
79.     For Each EntObj In SSetObj
    
80.         v = EntObj.IntersectWith(RayObj, acExtendNone)
    
81.         ' 直线与射线相交
    
82.         If Not IsEmpty(v) Then
    
83.             If UBound(v) > 0 Then If v(0) >= MinX Then MinX = v(0)
    
84.         End If
    
85.     Next
    
86.     RayObj.Delete
    
87.    
    
88.     ' 确定射线的另一点（两点定出方向，这里是南向）
    
89.     tPt = ThisDrawing.Utility.PolarPoint(Pt, PI * 3 / 2, 1)
    
90. 
    
91.     ' 创建射线
    
92.     Set RayObj = ThisDrawing.ModelSpace.AddRay(Pt, tPt)
    
93.    
    
94.     Dim MinY As Double
    
95.     MinY = -99999999
    
96.     ' 枚举选择集
    
97.     For Each EntObj In SSetObj
    
98.         v = EntObj.IntersectWith(RayObj, acExtendNone)
    
99.         ' 直线与射线相交
    
100.         If Not IsEmpty(v) Then
     
101.             If UBound(v) > 0 Then If v(1) >= MinY Then MinY = v(1)
     
102.         End If
     
103.     Next
     
104.     RayObj.Delete
     
105.     Set RayObj = Nothing
     
106.     Set EntObj = Nothing
     
107.     Set SSetObj = Nothing
     
108.    
     
109.     ' 打印数据
     
110.     Debug.Print "单元格的宽度: " & MaxX - MinX
     
111.     Debug.Print "单元格的高度: " & MaxY - MinY
     
112.     Debug.Print "单元格的左下角点: " & MinX & "," & MinY
     
113.     Debug.Print "单元格的右上角点: " & MaxX & "," & MaxY
     
114.     Debug.Print "单元格的中心点: " & (MinX + MaxX) / 2 & "," & (MinY + MaxY) / 2
     
115.     Exit Sub
     
116.    
     
117. ErrTrap:
     
118.     On Error GoTo 0
     
119. End Sub
     
120. 
     
121. 立即窗口内容:
     
122. 单元格的宽度: 106.349332501451
     
123. 单元格的高度: 64.3045875866011
     
124. 单元格的左下角点: 181.33924617877,84.7403666158115
     
125. 单元格的右上角点: 287.688578680221,149.044954202413
     
126. 单元格的中心点: 234.513912429495,116.892660409112
     
127.   [/FONT]
     

<br />   [FONT=courier new]<br /> Sub test()<br />     Const PI = 3.1415926<br />     <br />     On Error Resume Next<br />     ' 创建选择集<br />     Dim SSetObj As Object<br />     Set SSetObj = ThisDrawing.SelectionSets("SSET")<br />     If Err.Number <> 0 Then<br />         Err.Clear<br />         Set SSetObj = ThisDrawing.SelectionSets.Add("SSET")<br />     End If<br />     SSetObj.Clear<br />     <br />     On Error GoTo ErrTrap<br />     '创建过滤机制<br />     Dim fType(0 To 0) As Integer<br />     Dim fData(0 To 0) As Variant<br />     fType(0) = 0: fData(0) = "LINE"<br />     <br />     '选择所有直线<br />     SSetObj.Select acSelectionSetAll, , , fType, fData<br />     <br />     ' 选择点<br />     Dim Pt As Variant<br />     Pt = ThisDrawing.Utility.GetPoint(, "指定单元格内的一点: ")<br />     <br />     ' 确定射线的另一点（两点定出方向，这里是东向）<br />     Dim tPt As Variant<br />     tPt = ThisDrawing.Utility.PolarPoint(Pt, 0, 1)<br /> <br />     ' 创建射线<br />     Dim RayObj As AcadRay<br />     Set RayObj = ThisDrawing.ModelSpace.AddRay(Pt, tPt)<br />     <br />     Dim MaxX As Double<br />     MaxX = 99999999<br />     Dim EntObj As AcadEntity<br />     Dim v As Variant<br />     ' 枚举选择集<br />     For Each EntObj In SSetObj<br />         v = EntObj.IntersectWith(RayObj, acExtendNone)<br />         ' 直线与射线相交<br />         If Not IsEmpty(v) Then<br />             If UBound(v) > 0 Then If v(0) <= MaxX Then MaxX = v(0)<br />         End If<br />     Next<br />     RayObj.Delete<br />     <br />     ' 确定射线的另一点（两点定出方向，这里是北向）<br />     tPt = ThisDrawing.Utility.PolarPoint(Pt, PI / 2, 1)<br /> <br />     ' 创建射线<br />     Set RayObj = ThisDrawing.ModelSpace.AddRay(Pt, tPt)<br />     <br />     Dim MaxY As Double<br />     MaxY = 99999999<br />     ' 枚举选择集<br />     For Each EntObj In SSetObj<br />         v = EntObj.IntersectWith(RayObj, acExtendNone)<br />         ' 直线与射线相交<br />         If Not IsEmpty(v) Then<br />             If UBound(v) > 0 Then If v(1) <= MaxY Then MaxY = v(1)<br />         End If<br />     Next<br />     RayObj.Delete<br />     <br />     ' 确定射线的另一点（两点定出方向，这里是西向）<br />     tPt = ThisDrawing.Utility.PolarPoint(Pt, PI, 1)<br /> <br />     ' 创建射线<br />     Set RayObj = ThisDrawing.ModelSpace.AddRay(Pt, tPt)<br />     <br />     Dim MinX As Double<br />     MinX = -99999999<br />     ' 枚举选择集<br />     For Each EntObj In SSetObj<br />         v = EntObj.IntersectWith(RayObj, acExtendNone)<br />         ' 直线与射线相交<br />         If Not IsEmpty(v) Then<br />             If UBound(v) > 0 Then If v(0) >= MinX Then MinX = v(0)<br />         End If<br />     Next<br />     RayObj.Delete<br />     <br />     ' 确定射线的另一点（两点定出方向，这里是南向）<br />     tPt = ThisDrawing.Utility.PolarPoint(Pt, PI * 3 / 2, 1)<br /> <br />     ' 创建射线<br />     Set RayObj = ThisDrawing.ModelSpace.AddRay(Pt, tPt)<br />     <br />     Dim MinY As Double<br />     MinY = -99999999<br />     ' 枚举选择集<br />     For Each EntObj In SSetObj<br />         v = EntObj.IntersectWith(RayObj, acExtendNone)<br />         ' 直线与射线相交<br />         If Not IsEmpty(v) Then<br />             If UBound(v) > 0 Then If v(1) >= MinY Then MinY = v(1)<br />         End If<br />     Next<br />     RayObj.Delete<br />     Set RayObj = Nothing<br />     Set EntObj = Nothing<br />     Set SSetObj = Nothing<br />     <br />     ' 打印数据<br />     Debug.Print "单元格的宽度: " & MaxX - MinX<br />     Debug.Print "单元格的高度: " & MaxY - MinY<br />     Debug.Print "单元格的左下角点: " & MinX & "," & MinY<br />     Debug.Print "单元格的右上角点: " & MaxX & "," & MaxY<br />     Debug.Print "单元格的中心点: " & (MinX + MaxX) / 2 & "," & (MinY + MaxY) / 2<br />     Exit Sub<br />     <br /> ErrTrap:<br />     On Error GoTo 0<br /> End Sub<br /> <br /> 立即窗口内容: <br /> 单元格的宽度: 106.349332501451<br /> 单元格的高度: 64.3045875866011<br /> 单元格的左下角点: 181.33924617877,84.7403666158115<br /> 单元格的右上角点: 287.688578680221,149.044954202413<br /> 单元格的中心点: 234.513912429495,116.892660409112<br />   [/FONT]<br />

追日

谢谢版主