老师们，我怎么把我在cad上的vba 转成 vb6.0 代码然后生成exe 可以吗？

373294296

Sub GetObjInSet()
  On Error Resume Next
  Dim ssetObj As AcadSelectionSet
   Dim FilterType(0) As Integer
   Dim FilterData(0) As Variant
   Dim dm As AcadRegion
   Dim drm As Variant
   Dim b As Long
   FilterType(0) = 0
   FilterData(0) = "LWPOLYLINE"
   Dim entities As Variant
   Dim mianji As Double
   Dim entt As AcadText
'-------------------------------------------------------------------------------------
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET" & Time)
ssetObj.SelectOnScreen FilterType, FilterData
'--------------------------------------------------------------------------------------------
  Dim ent(0) As AcadEntity
  Dim forma As Variant
For b = 0 To ssetObj.Count - 1
   Set ent(0) = ssetObj(b)

  mianji = Round(ent(0).Area * 0.0015, 2)
forma = Format(mianji, "0.00")
   entities = ThisDrawing.ModelSpace.AddRegion(ent)
    Set dm = entities(0)
     drm = dm.Centroid
     dm.Delete
'---------------------------------------------------------------------------------------------------
     Dim porinta() As Double
     ReDim porinta(UBound(drm) + 1) As Double
   Dim i As Integer
   For i = 0 To (UBound(drm) / 2)
   porinta(3 * i) = drm(2 * i)
   porinta(3 * i + 1) = drm(2 * i + 1)
   porinta(3 * 1 + 2) = 0
   Next

entt = ThisDrawing.ModelSpace.AddText(forma & "亩", porinta, 1)
Next
End Sub

老师这是vba 代码 ，最好讲的详细一点， 对vb6.0不是太熟悉，比如 新建exe 工程 把代码复制进去，  工程引用CAD2006，然后怎么做呢？  求解

373294296

求大神解决 帮忙 解决？？？  

renmx01

百度vb控制CAD。多几行代码

373294296

下午有遇到了问题了， 我为什么在cass  写属性， 多段线批量转成权属线
     Dim datatype(0 To 4) As Integer
    Dim data(0 To 4) As Variant
datatype(0) = 1001: data(0) = "SOUTH"
datatype(1) = 1000: data(1) = "300000"
datatype(2) = 1000: data(2) = dn(1)
datatype(3) = 1000: data(3) = dn(0)
datatype(4) = 1000: data(4) = "072"
objSelect.SetXData datatype, data
为什么和 cass  里直接绘制的权属线， 或 复合线转成权属线 的性质， 还不一样呢？

zzyong00

http://bbs.mjtd.com/thread-111783-1-1.html

373294296

高手来 哈， cass , 我为什么 我把 多段线 写入的属性 “SOUTH” 写进去， 变成权属线了， 但是这个权属线还是跟cass 直接画的线  不一样

poly168

写入“SOUTH"是因为CASS会识别是不是用CASS生成的图元，权属不一样的原因是这个线原来就有属性了，再添加的话顺序不一样，另一个原因就是编码与CASS不一样。最好的办法就是直接生成多段线，然后按CASS写入的属性一致的方法写入属性就行了，CASS的属性可以读取CASS标准图元的属性方法:.getadata datatype, data,然后分别显示datatype,data变体中每一个值。有什么问题可以联系我：qq38968681

373294296

那老师，怎么正确的把多段线 写入宗地属性的值呢？？？ 我用了好多方法都不是太对？？？

373294296

2. Sub dd1223()
   
3. On Error Resume Next
   
4. 
   
5.    Dim datatype(0 To 1) As Integer
   
6.    Dim data(0 To 1) As Variant
   
7.    Dim xtypeOut As Variant, XDateOut As Variant
   
8.    Dim objCurrent As AcadEntity
   
9.    Dim basePnt As Variant
   
10.    Dim ss As AcadSelectionSet
    
11.    Dim minExt As Variant
    
12.    Dim maxExt As Variant
    
13.   '--------------------------------------------------------------------------------------------
    
14.     If Not IsNull(ThisDrawing.SelectionSets.Item("11")) Then
    
15.     Set ss = ThisDrawing.SelectionSets.Item("11")
    
16.     ss.Delete
    
17.     End If
    
18.   '---------------------------------------------------------------------------------------------
    
19.   Dim filtertype(0) As Integer
    
20.   Dim filterdata(0) As Variant
    
21.   filtertype(0) = 0
    
22.   filterdata(0) = "LWPOLYLINE"
    
23.    Set ss = ThisDrawing.Application.ActiveDocument.SelectionSets.Add("11")
    
24.    ss.SelectOnScreen filtertype, filterdata
    
25. '-----------------------------------------------------------------------------------------------
    
26.   Dim datatypee(0 To 4) As Integer
    
27.   Dim dataa(0 To 4) As Variant
    
28. '------------------------------------------------------------------
    
29. For Each objCurrent In ss
    
30. 
    
31.    datatypee(0) = 1001: dataa(0) = "SOUTH"
    
32.    datatypee(1) = 1000: dataa(1) = "300000"
    
33.    datatypee(2) = 1000: dataa(2) = ""
    
34.    datatypee(3) = 1000: dataa(3) = ""
    
35.    datatypee(4) = 1000: dataa(4) = "072"
    
36.   
    
37.     objCurrent.SetXData datatypee, dataa
    
38.     objCurrent.GetXData "", xtypeOut, XDateOut
    
39.    
    
40.     datatype(0) = 1001: data(0) = "QHDM"
    
41.     datatype(1) = 1000: data(1) = ""
    
42.    
    
43.     objCurrent.SetXData datatype, data
    
44.     objCurrent.GetXData "", xtypeOut, XDateOut
    
45.    
    
46.     datatype(0) = 1001: data(0) = "SJZGBM"
    
47.     datatype(1) = 1000: data(1) = ""
    
48.    
    
49.     objCurrent.SetXData datatype, data
    
50.     objCurrent.GetXData "", xtypeOut, XDateOut
    
51.    
    
52.     datatype(0) = 1001: data(0) = "FRDBXM"
    
53.     datatype(1) = 1000: data(1) = ""
    
54.    
    
55.     objCurrent.SetXData datatype, data
    
56.     objCurrent.GetXData "", xtypeOut, XDateOut
    
57.    
    
58.     datatype(0) = 1001: data(0) = "FRDBZMS"
    
59.     datatype(1) = 1000: data(1) = ""
    
60.     objCurrent.SetXData datatype, data
    
61.     objCurrent.GetXData "", xtypeOut, XDateOut
    
62.    
    
63.     datatype(0) = 1001: data(0) = "FRDBDH"      '
    
64.     datatype(1) = 1000: data(1) = ""
    
65.     objCurrent.SetXData datatype, data
    
66.     objCurrent.GetXData "", xtypeOut, XDateOut
    
67.    
    
68.     datatype(0) = 1001: data(0) = "DLRXM"      '
    
69.     datatype(1) = 1000: data(1) = ""
    
70.     objCurrent.SetXData datatype, data
    
71.     objCurrent.GetXData "", xtypeOut, XDateOut
    
72.    
    
73.     datatype(0) = 1001: data(0) = "DLRSFZ"
    
74.     datatype(1) = 1000: data(1) = ""
    
75.     objCurrent.SetXData datatype, data
    
76.     objCurrent.GetXData "", xtypeOut, XDateOut
    
77.    
    
78.     datatype(0) = 1001: data(0) = "DLRDH"
    
79.     datatype(1) = 1000: data(1) = ""
    
80.     objCurrent.SetXData datatype, data
    
81.     objCurrent.GetXData "", xtypeOut, XDateOut
    
82.    
    
83.     datatype(0) = 1001: data(0) = "TXDZ"
    
84.     datatype(1) = 1000: data(1) = ""
    
85.     objCurrent.SetXData datatype, data
    
86.     objCurrent.GetXData "", xtypeOut, XDateOut
    
87.    
    
88.     datatype(0) = 1001: data(0) = "TDZL"
    
89.     datatype(1) = 1000: data(1) = ""
    
90.     objCurrent.SetXData datatype, data
    
91.     objCurrent.GetXData "", xtypeOut, XDateOut
    
92.    
    
93.     datatype(0) = 1001: data(0) = "DONGZHI"
    
94.     datatype(1) = 1000: data(1) = ""
    
95.     objCurrent.SetXData datatype, data
    
96.     objCurrent.GetXData "", xtypeOut, XDateOut
    
97. 
    
98.     datatype(0) = 1001: data(0) = "NANZHI"
    
99.     datatype(1) = 1000: data(1) = ""
    
100.     objCurrent.SetXData datatype, data
     
101.     objCurrent.GetXData "", xtypeOut, XDateOut
     
102. 
     
103.     datatype(0) = 1001: data(0) = "XIZHI"
     
104.     datatype(1) = 1000: data(1) = ""
     
105.     objCurrent.SetXData datatype, data
     
106.     objCurrent.GetXData "", xtypeOut, XDateOut
     
107. 
     
108.     datatype(0) = 1001: data(0) = "BEIZHI"
     
109.     datatype(1) = 1000: data(1) = ""
     
110.     objCurrent.SetXData datatype, data
     
111.     objCurrent.GetXData "", xtypeOut, XDateOut
     
112. 
     
113.     datatype(0) = 1001: data(0) = "QSLYZM"
     
114.     datatype(1) = 1000: data(1) = ""
     
115.     objCurrent.SetXData datatype, data
     
116.     objCurrent.GetXData "", xtypeOut, XDateOut
     
117.    
     
118.     datatype(0) = 1001: data(0) = "PZTDYT"
     
119.     datatype(1) = 1000: data(1) = ""
     
120.     objCurrent.SetXData datatype, data
     
121.     objCurrent.GetXData "", xtypeOut, XDateOut
     
122.    
     
123.     datatype(0) = 1001: data(0) = "TDSYZ"
     
124.     datatype(1) = 1000: data(1) = ""
     
125.     objCurrent.SetXData datatype, data
     
126.     objCurrent.GetXData "", xtypeOut, XDateOut
     
127.    
     
128.     datatype(0) = 1001: data(0) = "SBJZWQS"
     
129.     datatype(1) = 1000: data(1) = ""
     
130.     objCurrent.SetXData datatype, data
     
131.     objCurrent.GetXData "", xtypeOut, XDateOut
     
132.    
     
133.     datatype(0) = 1001: data(0) = "YBDJH"
     
134.     datatype(1) = 1000: data(1) = ""
     
135.         objCurrent.SetXData datatype, data
     
136.     objCurrent.GetXData "", xtypeOut, XDateOut
     
137.    
     
138.     datatype(0) = 1001: data(0) = "TDZH"
     
139.     datatype(1) = 1000: data(1) = ""
     
140.         objCurrent.SetXData datatype, data
     
141.     objCurrent.GetXData "", xtypeOut, XDateOut
     
142.    
     
143.     datatype(0) = 1001: data(0) = "SHRQ"
     
144.     datatype(1) = 1000: data(1) = ""
     
145.         objCurrent.SetXData datatype, data
     
146.     objCurrent.GetXData "", xtypeOut, XDateOut
     
147.    
     
148.     datatype(0) = 1001: data(0) = "DJRQ"
     
149.     datatype(1) = 1000: data(1) = ""
     
150.         objCurrent.SetXData datatype, data
     
151.     objCurrent.GetXData "", xtypeOut, XDateOut
     
152.    
     
153.     datatype(0) = 1001: data(0) = "ZZRQ"
     
154.     datatype(1) = 1000: data(1) = ""
     
155.         objCurrent.SetXData datatype, data
     
156.     objCurrent.GetXData "", xtypeOut, XDateOut
     
157.    
     
158.     datatype(0) = 1001: data(0) = "DWXZ"
     
159.     datatype(1) = 1000: data(1) = ""
     
160.         objCurrent.SetXData datatype, data
     
161.     objCurrent.GetXData "", xtypeOut, XDateOut
     
162.    
     
163.     datatype(0) = 1001: data(0) = "QSXZ"
     
164.     datatype(1) = 1000: data(1) = ""
     
165.         objCurrent.SetXData datatype, data
     
166.     objCurrent.GetXData "", xtypeOut, XDateOut
     
167.    
     
168.     datatype(0) = 1001: data(0) = "SYQLX"
     
169.     datatype(1) = 1000: data(1) = ""
     
170.         objCurrent.SetXData datatype, data
     
171.     objCurrent.GetXData "", xtypeOut, XDateOut
     
172.    
     
173.     datatype(0) = 1001: data(0) = "TDDJ"
     
174.     datatype(1) = 1000: data(1) = ""
     
175.         objCurrent.SetXData datatype, data
     
176.     objCurrent.GetXData "", xtypeOut, XDateOut
     
177.    
     
178.     datatype(0) = 1001: data(0) = "MPH"
     
179.     datatype(1) = 1000: data(1) = ""
     
180.         objCurrent.SetXData datatype, data
     
181.     objCurrent.GetXData "", xtypeOut, XDateOut
     
182.    
     
183.     datatype(0) = 1001: data(0) = "TUFU"
     
184.     datatype(1) = 1000: data(1) = ""
     
185.         objCurrent.SetXData datatype, data
     
186.     objCurrent.GetXData "", xtypeOut, XDateOut
     
187.    
     
188.    
     
189.     datatype(0) = 1001: data(0) = "JZMJ"
     
190.     datatype(1) = 1000: data(1) = ""
     
191.         objCurrent.SetXData datatype, data
     
192.     objCurrent.GetXData "", xtypeOut, XDateOut
     
193.    
     
194.     datatype(0) = 1001: data(0) = "BDDJ"
     
195.     datatype(1) = 1000: data(1) = ""
     
196.         objCurrent.SetXData datatype, data
     
197.     objCurrent.GetXData "", xtypeOut, XDateOut
     
198.    
     
199.     datatype(0) = 1001: data(0) = "SBDJ"
     
200.     datatype(1) = 1000: data(1) = ""
     
201.         objCurrent.SetXData datatype, data
     
202.     objCurrent.GetXData "", xtypeOut, XDateOut
     
203.     objCurrent.color = acCyan
     
204.    
     
205.     objCurrent.GetBoundingBox minExt, maxExt
     
206.     Sleep 1
     
207.     ZoomWindow minExt, maxExt
     
208.     Sleep 1
     
209.     Next objCurrent
     
210.    ss.Delete
     
211.   End Sub

Sub dd1223()<br /> On Error Resume Next<br /> <br />    Dim datatype(0 To 1) As Integer<br />    Dim data(0 To 1) As Variant<br />    Dim xtypeOut As Variant, XDateOut As Variant<br />    Dim objCurrent As AcadEntity<br />    Dim basePnt As Variant<br />    Dim ss As AcadSelectionSet<br />    Dim minExt As Variant<br />    Dim maxExt As Variant<br />   '--------------------------------------------------------------------------------------------<br />     If Not IsNull(ThisDrawing.SelectionSets.Item("11")) Then<br />     Set ss = ThisDrawing.SelectionSets.Item("11")<br />     ss.Delete<br />     End If<br />   '---------------------------------------------------------------------------------------------<br />   Dim filtertype(0) As Integer<br />   Dim filterdata(0) As Variant<br />   filtertype(0) = 0<br />   filterdata(0) = "LWPOLYLINE"<br />    Set ss = ThisDrawing.Application.ActiveDocument.SelectionSets.Add("11")<br />    ss.SelectOnScreen filtertype, filterdata<br /> '-----------------------------------------------------------------------------------------------<br />   Dim datatypee(0 To 4) As Integer<br />   Dim dataa(0 To 4) As Variant<br /> '------------------------------------------------------------------<br /> For Each objCurrent In ss<br /> <br />    datatypee(0) = 1001: dataa(0) = "SOUTH"<br />    datatypee(1) = 1000: dataa(1) = "300000"<br />    datatypee(2) = 1000: dataa(2) = ""<br />    datatypee(3) = 1000: dataa(3) = ""<br />    datatypee(4) = 1000: dataa(4) = "072"<br />   <br />     objCurrent.SetXData datatypee, dataa<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "QHDM"<br />     datatype(1) = 1000: data(1) = ""<br />     <br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "SJZGBM"<br />     datatype(1) = 1000: data(1) = ""<br />     <br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "FRDBXM"<br />     datatype(1) = 1000: data(1) = ""<br />     <br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "FRDBZMS"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "FRDBDH"      '<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "DLRXM"      '<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "DLRSFZ"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "DLRDH"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "TXDZ"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "TDZL"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "DONGZHI"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br /> <br />     datatype(0) = 1001: data(0) = "NANZHI"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br /> <br />     datatype(0) = 1001: data(0) = "XIZHI"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br /> <br />     datatype(0) = 1001: data(0) = "BEIZHI"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br /> <br />     datatype(0) = 1001: data(0) = "QSLYZM"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "PZTDYT"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "TDSYZ"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "SBJZWQS"<br />     datatype(1) = 1000: data(1) = ""<br />     objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "YBDJH"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "TDZH"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "SHRQ"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "DJRQ"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "ZZRQ"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "DWXZ"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "QSXZ"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "SYQLX"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "TDDJ"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "MPH"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "TUFU"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     <br />     datatype(0) = 1001: data(0) = "JZMJ"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "BDDJ"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     <br />     datatype(0) = 1001: data(0) = "SBDJ"<br />     datatype(1) = 1000: data(1) = ""<br />         objCurrent.SetXData datatype, data<br />     objCurrent.GetXData "", xtypeOut, XDateOut<br />     objCurrent.color = acCyan<br />     <br />     objCurrent.GetBoundingBox minExt, maxExt<br />     Sleep 1<br />     ZoomWindow minExt, maxExt<br />     Sleep 1<br />     Next objCurrent<br />    ss.Delete<br />   End Sub

老师这是我写入宗地属性的全部代码， 你帮我看看 ，对不对， 有点乱，如果有错的地方？？？请帮我指出来 先谢谢了 ，老师？