szj612 发表于 2015-2-5 01:43:39

很好很强大，受教了，感谢楼主!能不能讲一些用vb6改写VBA源码的知识，我想发布一些vba程序，但又不希望别人看到源码，所以希望用VB6编译一下，这样就相对安全一些，呵呵，不知道这样弄了之后在使用上有些什么区别？还请赐教!

zzyong00 发表于 2015-2-7 23:53:50

本帖最后由 zzyong00 于 2015-2-7 23:55 编辑

用VB和VBA开发的人实在太少了，本版块真是人气凋零啊

szj612 发表于 2015-2-8 05:06:23

谢谢赐教，我再好好消化一下前面的内容

jinmaji 发表于 2015-2-11 14:26:33

pmq 发表于 2015-2-12 20:10:45

谢谢楼主，学习了。

MTC 发表于 2015-3-4 10:26:41

太牛了好好消化一下

wycl8 发表于 2015-3-16 10:29:09

支持，楼主辛苦了

zjy2999 发表于 2015-3-18 09:15:06

xuexile!!!!!!!!!!!!

xsshhl 发表于 2015-3-20 13:14:33

向你好好学习学习

zzyong00 发表于 2015-3-26 22:40:58

今天看见一个用三维多线段作的地形图，没用拟合平滑。这种线，看着闹心，所以写个小代码转成多线段了！
On Error GoTo err1
    Dim blnDel As Boolean
    blnDel = IIf(MsgBox("是否删除源三维多线段？" & vbCrLf & "提示：如果三维多线段采用'拟合/平滑'，转换后不准确！", vbYesNo + vbQuestion, "MEA") = vbYes, True, False)
   
    AppActivate objCad.Caption
    Dim objSset As AcadSelectionSet
    Dim objDoc As AcadDocument
    Set objDoc = ThisDrawing()
    SelectLots "MEA~PL~TMP~123", "POLYLINE" ' 三维多线段
    Set objSset = objDoc.SelectionSets("MEA~PL~TMP~123")
    If objSset.Count = 0 Then Exit Sub
    Dim obj1 As Acad3DPolyline
    Dim objPL As AcadLWPolyline
    Dim coords As Variant, coords2() As Double, dblElv As Double, flag As Boolean
    Dim i As Long, j As Long
    For Each obj1 In objSset
      'Debug.Print obj1.ObjectName
      flag = False
      dblElv = 0
      i = 0: j = 0
      coords = obj1.Coordinates
      ReDim coords2(CLng((UBound(coords) + 1) / 3 * 2) - 1)
      For i = 0 To UBound(coords)
            If (i + 1) Mod 3 = 0 Then
                If Not flag Then 'z坐标不一致，放弃对标高的转换，全为0
                  If i = 2 Then
                        dblElv = coords(2)
                  Else
                        If Abs(dblElv - coords(i)) > 0.00001 Then flag = True: dblElv = 0 '放弃标高
                  End If
                End If
            Else
                coords2(j) = coords(i)
                j = j + 1
            End If
      Next i
      Set objPL = objDoc.ModelSpace.AddLightWeightPolyline(coords2)
      objPL.Elevation = dblElv
      objPL.Update
      If blnDel Then obj1.Delete
    Next obj1
    Exit Sub
err1:
    Err.Clear
    Debug.Print "三维多线段转多线段出错！"
页: 1 2 3 4 [5] 6 7 8 9 10 11 12 13 14
查看完整版本: 用VB6进行Autocad的二次开发(原创)