zoukankan      html  css  js  c++  java
  • AutoCAD VBA文字自动对齐操作

    AutoCAD VBA文字自动对齐,代码如下。

    Public Type TextWithPnt
    Index As Long
    TextObj As AcadText
    PntIntX As Double
    PntIntY As Double
    PntLeftX As Double
    PntMidX As Double
    PntRigX As Double
    End Type
    Public OrgTexts() As TextWithPnt
    Public Function CreateSSet(Optional SS As String = "mjtd") As AcadSelectionSet
    On Error Resume Next
    ThisDrawing.SelectionSets(SS).Delete
    Set CreateSSet = ThisDrawing.SelectionSets.Add(SS)
    End Function
    Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
    Dim fType() As Integer, fData()
    Dim Index As Long, i As Long
    Index = LBound(gCodes) - 1
    For i = LBound(gCodes) To UBound(gCodes) Step 2
    Index = Index + 1
    ReDim Preserve fType(0 To Index)
    ReDim Preserve fData(0 To Index)
    fType(Index) = CInt(gCodes(i))
    fData(Index) = gCodes(i + 1)
    Next
    End Sub
    Public Function ssExtents(SS As AcadSelectionSet) As Variant
    Dim Points(), C As Long
    Dim Min As Variant, Max As Variant
    Dim i As Long, j As Long
    C = 0
    For i = 0 To SS.count - 1
    SS.Item(i).GetBoundingBox Min, Max
    ReDim Preserve Points(0 To C + 1)
    Points(C) = Min: Points(C + 1) = Max
    C = C + 2
    Next
    ssExtents = Extents(Points)
    End Function
    Public Function Extents(Points)
    Dim Min As Variant, Max As Variant
    Dim i As Long, j As Long, Pt, RetVal(0 To 1)
    Min = Points(LBound(Points))
    Max = Points(LBound(Points))
    For i = LBound(Points) To UBound(Points)
    Pt = Points(i)
    For j = LBound(Pt) To UBound(Pt)
    If Pt(j) < Min(j) Then Min(j) = Pt(j)
    If Pt(j) > Max(j) Then Max(j) = Pt(j)
    Next
    Next
    RetVal(0) = Min: RetVal(1) = Max
    Extents = RetVal
    End Function

    代码完。

    作者:codee
    文章千古事,得失寸心知。


  • 相关阅读:
    搭建LAMP及wordpress
    httpd2.4常用配置
    编译安装httpd 2.4
    https加密实现
    httpd常用配置
    源码编译安装bind
    安装mariadb二进制程序
    搭建互联网DNS构架
    搭建DNS服务
    主从及转发DNS搭建
  • 原文地址:https://www.cnblogs.com/bimgoo/p/2502900.html
Copyright © 2011-2022 走看看