[LISP程序]：換一種思路實現利用VBA编程实现从EXCEL表到AUTOCAD表转换

clyuyu

利用VBA编程实现从EXCEL表到AUTOCAD表转换
-- 3、表格文字转换

---- 表格文字转换包括表格文字本身转换和表格文字在表格中位置的转换两个部分。

---- 在AutoCAD中，文字标注的形式有多种，与Microsoft Excel 单元格区域多行文本内容相对应的是多行文本命令。AutoCAD提供的VBA添加多行文本的命令语句是：

RetVal = object.AddMText(InsertionPoint, Width, Text)

---- 通过修改RetVal的属性可以控制表格文字在表格中的位置。

---- (1)．表格文字本身的转换

---- 分析AddMText命令可以得出：表格文字所在位置、文字内容宽度，文字内容，均可通过此命令来添加。然而表格文字字体，大小，下划线、上下脚标，倾斜，加粗等却不能。一般的方法是采用修改字体形文件的方法来实现，方法烦琐，不便于实现，而且仅对修改过形文件的字体有效。况且当同一文字块内的不同文字的字体，大小，下划线、上下脚标，倾斜，加粗不同时，使用修改字体形文件的方法也无法实现。本文介绍一种直接利用Mtext命令提供的方法进行转换。

---- 在AddMText命令中，影响文字内容和文字属性的参数Text。在具体文字前加上一定的控制符号可以控制文字的文字属性，具体控制符号可以参阅AutoCAD帮助文件。例如，{\F宋体；\Q18;\W1.2;ABCDEFG}把“ABCDEFG”设置成宋体、向右倾斜18度，每个字的宽度是正常宽度1.2倍。

---- 本程序具体采用的方法是：读取Microsoft Excel文件某一单元格区域里的某第j个字符属性（字体，大小，下划线、上、下脚标，倾斜，加粗），读取Microsoft Excel文件某一单元格区域里的某第j+1个字符属性，如果与第j个字符相同，则二者采用同样的控制符号；若不同，则从第j+1个字符开始，重复前面的工作。

Sub wz (  )
Char = RTrim(Left(c.Characters.Caption, 256))
If Char < > Empty Then
   textStr = ""
   For j = 1 To Len(Char)
  If c.Characters(j, 1).Font.Underline =
         xlUnderlineStyleNone Then
          cpt = c.Characters(j, 1).Caption
          sonstr = ForeFontStr(c, j)
          tempstr = ""
          Do While j + 1 < = Len(Char)
               sonstr1 = ForeFontStr(c, j + 1)
               If sonstr1 = sonstr Then
                  j = j + 1
                  tempstr = tempstr + c.Characters(j,
        1).Caption
               Else
                  Exit Do
               End If
          Loop
          textStr = textStr + "{" + sonstr + cpt
         + tempstr + "}"
      Else
          cpt = c.Characters(j, 1).Caption
          sonstr = ForeFontStr(c, j)
          tempstr = ""
          Do While j + 1 < = Len(Char)
              sonstr1 = ForeFontStr(c, j + 1)
              If sonstr1 = sonstr Then
                 j = j + 1
                 tempstr = tempstr + c.Characters(j,
         1).Caption
              Else
                 Exit Do
              End If
       Loop
           textStr = textStr + "{\L" +
           sonstr + cpt + tempstr + "\l}"
       End If
   Next j
End If
End Sub   
‘下面函数控制字体本身属性
Function ForeFontStr(m As Range, u As Integer) As String
    a1 = "\F" + m.Characters(u, 1).Font.Name + ";"  ‘字体
a2 = IIf(m.Characters(u, 1).Font.Superscript =
True, "\H0.33x;\A2;", "")  '上脚标
a3 = IIf(m.Characters(u, 1).Font.Subscript =
True, "\H0.33x;\A0;", "")  '下脚标
a4 = IIf(m.Characters(u, 1).Font.FontStyle =
"倾斜", "\Q18;", "")  '倾斜
a5 = IIf(m.Characters(u, 1).Font.FontStyle =
"加粗", "\W1.2;", "")  '加粗
a6 = IIf(m.Characters(u, 1).Font.FontStyle =
"加粗 倾斜", "\W1.2;\Q18;", "")  ' 加粗倾斜  
ForeFontStr = a1 + a2 + a3 + a4 + a5 + a6
End Function

---- （2）.表格中表格文字位置的转换

---- 对文字对象的属性的直接控制来实现，通过with….end with 结构可以很容易地控制文字的高度、图层、颜色、书写方向。由于Mtext文字提供支持的排列位置分为9种，必须根据Microsoft Excel表格文字的排列方式加以合适的判定，然后进行转换。其具体的实现方法详见下面的程序。

Sub kz( )
With textObj ‘文字对象
    .Height = textHgt
    .Layer = newlayer.Name  ‘设置图层
    .Color = acRed          ‘设置颜色
    .DrawingDirection = 1    ‘设置书写方向
   If (ma.VerticalAlignment = xlTop _
       Or ma.VerticalAlignment = xlGeneral) _
       And (ma.HorizontalAlignment = xlLeft _
       Or ma.HorizontalAlignment = xlGeneral) _
       Then .AttachmentPoint = 1  'acAttachmentPointTopLeft
   If (ma.VerticalAlignment = xlTop _
       Or ma.VerticalAlignment = xlGeneral) _
       And (ma.HorizontalAlignment = xlCenter _
       Or ma.HorizontalAlignment = xlJustify _
       Or ma.HorizontalAlignment = xlDistributed) _
       Then .AttachmentPoint = 2  'acAttachmentPointTopCenter
   If (ma.VerticalAlignment = xlTop _
       Or ma.VerticalAlignment = xlGeneral) _
       And ma.HorizontalAlignment = xlRight _
       Then .AttachmentPoint = 3  'acAttachmentPointTopRight
   If (ma.VerticalAlignment = xlCenter _
       Or ma.VerticalAlignment = xlJustify _
       Or ma.VerticalAlignment = xlDistributed) _
       And (ma.HorizontalAlignment = xlLeft _
       Or ma.HorizontalAlignment = xlGeneral) _
       Then .AttachmentPoint = 4  'acAttachmentPointMiddleLeft
   If (ma.VerticalAlignment = xlCenter _
       Or ma.VerticalAlignment = xlJustify _
       Or ma.VerticalAlignment = xlDistributed) _
       And (ma.HorizontalAlignment = xlCenter _
       Or ma.HorizontalAlignment = xlJustify _
       Or ma.HorizontalAlignment = xlDistributed) _
       Then .AttachmentPoint = 5  'acAttachmentPointMiddleCenter
   If (ma.VerticalAlignment = xlCenter _
       Or ma.VerticalAlignment = xlJustify _
       Or ma.VerticalAlignment = xlDistributed) _
       And ma.HorizontalAlignment = xlRight _
       Then .AttachmentPoint = 6 'acAttachmentPointMiddleRight
   If ma.VerticalAlignment = xlBottom _
       And (ma.HorizontalAlignment = xlLeft _
       Or ma.HorizontalAlignment = xlGeneral) _
       Then .AttachmentPoint = 7  'acAttachmentPointBottomLeft
  If ma.VerticalAlignment = xlBottom _
       And (ma.HorizontalAlignment = xlCenter _
       Or ma.HorizontalAlignment = xlJustify _
       Or ma.HorizontalAlignment = xlDistributed) _
       Then .AttachmentPoint = 8  'acAttachmentPointBottomCenter
  If ma.VerticalAlignment = xlBottom _
       And ma.HorizontalAlignment = xlRight _
       Then .AttachmentPoint = 9  'acAttachmentPointBottomRight
End With
textObj.Update
End Sub

---- 三、功能与特点介绍

---- 该程序可将Excel表格中的所有单元格全部按原来大小、风格转换到AutoCAD文件中来。在转换过程中，表格线条的转换和文字转换是重点。文字转换采用了直接利用AddMtext命令提供的属性进行转换，避免了已往修改形文件来进行文字标注的方法，直接控制表格文字字体、大小、下划线、上下脚标，倾斜，加粗等，使每个文字的风格均可以得到很好的控制，极大提高了文字标注的灵活性。

地鼠

Function ForeFontStr(m As Range, u As Integer) As String
显示没有该数据类型

估计是range类型CAD不能识别
请问怎么解决才能用上你的程序。谢谢