373294296 发表于 2015-7-22 17:10:07

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

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 发表于 2015-7-22 17:32:25

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

renmx01 发表于 2015-7-23 17:43:14

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

373294296 发表于 2015-7-23 17:51:51

下午有遇到了问题了， 我为什么在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 发表于 2015-7-23 21:56:18

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

373294296 发表于 2015-7-24 10:50:53

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

poly168 发表于 2015-8-5 09:19:59

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

373294296 发表于 2015-8-5 23:09:59

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

373294296 发表于 2015-8-5 23:14:35

Sub dd1223()
On Error Resume Next

   Dim datatype(0 To 1) As Integer
   Dim data(0 To 1) As Variant
   Dim xtypeOut As Variant, XDateOut As Variant
   Dim objCurrent As AcadEntity
   Dim basePnt As Variant
   Dim ss As AcadSelectionSet
   Dim minExt As Variant
   Dim maxExt As Variant
'--------------------------------------------------------------------------------------------
    If Not IsNull(ThisDrawing.SelectionSets.Item("11")) Then
    Set ss = ThisDrawing.SelectionSets.Item("11")
    ss.Delete
    End If
'---------------------------------------------------------------------------------------------
Dim filtertype(0) As Integer
Dim filterdata(0) As Variant
filtertype(0) = 0
filterdata(0) = "LWPOLYLINE"
   Set ss = ThisDrawing.Application.ActiveDocument.SelectionSets.Add("11")
   ss.SelectOnScreen filtertype, filterdata
'-----------------------------------------------------------------------------------------------
Dim datatypee(0 To 4) As Integer
Dim dataa(0 To 4) As Variant
'------------------------------------------------------------------
For Each objCurrent In ss

   datatypee(0) = 1001: dataa(0) = "SOUTH"
   datatypee(1) = 1000: dataa(1) = "300000"
   datatypee(2) = 1000: dataa(2) = ""
   datatypee(3) = 1000: dataa(3) = ""
   datatypee(4) = 1000: dataa(4) = "072"

    objCurrent.SetXData datatypee, dataa
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "QHDM"
    datatype(1) = 1000: data(1) = ""
   
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "SJZGBM"
    datatype(1) = 1000: data(1) = ""
   
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "FRDBXM"
    datatype(1) = 1000: data(1) = ""
   
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "FRDBZMS"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "FRDBDH"      '
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "DLRXM"      '
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "DLRSFZ"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "DLRDH"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "TXDZ"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "TDZL"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "DONGZHI"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut

    datatype(0) = 1001: data(0) = "NANZHI"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut

    datatype(0) = 1001: data(0) = "XIZHI"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut

    datatype(0) = 1001: data(0) = "BEIZHI"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut

    datatype(0) = 1001: data(0) = "QSLYZM"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "PZTDYT"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "TDSYZ"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "SBJZWQS"
    datatype(1) = 1000: data(1) = ""
    objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "YBDJH"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "TDZH"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "SHRQ"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "DJRQ"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "ZZRQ"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "DWXZ"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "QSXZ"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "SYQLX"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "TDDJ"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "MPH"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "TUFU"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
   
    datatype(0) = 1001: data(0) = "JZMJ"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "BDDJ"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
   
    datatype(0) = 1001: data(0) = "SBDJ"
    datatype(1) = 1000: data(1) = ""
      objCurrent.SetXData datatype, data
    objCurrent.GetXData "", xtypeOut, XDateOut
    objCurrent.color = acCyan
   
    objCurrent.GetBoundingBox minExt, maxExt
    Sleep 1
    ZoomWindow minExt, maxExt
    Sleep 1
    Next objCurrent
   ss.Delete
End Sub老师这是我写入宗地属性的全部代码， 你帮我看看 ，对不对， 有点乱，如果有错的地方？？？请帮我指出来 先谢谢了 ，老师？
页: [1]
查看完整版本: 老师们，我怎么把我在cad上的vba 转成 vb6.0 代码然后生成exe 可以吗？