回答： 用vba实现Excel表格到CAD。下面代码供参考。

Attribute VB_Name = "模块3"

'该程序来自VBA二次开发CAD技术

Sub 根据Excel自动画表()

Dim xlApp As Excel.Application

Set xlApp = GetObject(, "Excel.Application")

Dim xlSheet As Worksheet

Set xlSheet = xlApp.ActiveSheet

Dim iPt(0 To 2) As Double

iPt(0) = 0: iPt(1) = 0: iPt(2) = 0

Dim BlockObj As ACADBlock

Set BlockObj = ThisDraWing.Blocks("*Model_Space")

Dim xlRange As Range

For Each xlRange In xlSheet.UsedRange

AddLine BlockObj, xlRange

AddText BlockObj, xlRange

Next

Set xlRange = Nothing

Set xlSheet = Nothing

Set xlApp = Nothing

End Sub

'边框处理

Sub AddLine(ByRef BlockObj As ACADBlock, ByVal xlRange As Range)

Dim rl As Double

Dim rt As Double

Dim rw As Double

Dim rh As Double

rl = xlRange.Left / 2.835

rt = xlRange.top / 2.835

rw = xlRange.Width / 2.835

rh = xlRange.Height / 2.835

Dim pPt(0 To 3) As Double

Dim pLineObj As ACADLWPolyline

If xlRange.Borders(xlEdgeLeft).LineStyle <> xlNone And xlRange.Column = 1 Then

pPt(0) = rl: pPt(1) = -rt

pPt(2) = rl: pPt(3) = -(rl + rh)

Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)

With xlRange.Borders(xlEdgeLeft)

If .ColorIndex <> xlAutomatic Then

If .ColorIndex = 3 Then

pLineObj.color = acRed

ElseIf .ColorIndex = 4 Then

pLineObj.color = acGreen

ElseIf .ColorIndex = 5 Then

pLineObj.color = acBlue

ElseIf .ColorIndex = 6 Then

pLineObj.color = acYellow

ElseIf .ColorIndex = 8 Then

pLineObj.color = acCyan

ElseIf .ColorIndex = 9 Then

pLineObj.color = acMagenta

End If

End If

If .Weight = xlThin Then

pLineObj.ConstantWidth = 0

ElseIf .Weight = xlMedium Then

pLineObj.ConstantWidth = 0.35

ElseIf .Weight = xlThick Then

pLineObj.ConstantWidth = 0.7

End If

End With

End If

If xlRange.Borders(xlEdgeBottom).LineStyle <> xlNone And (xlRange.Row = xlRange.MergeArea.Row + xlRange.MergeArea.Rows.Count - 1) Then

pPt(0) = rl: pPt(1) = -(rt + rh)

pPt(2) = rl + rw: pPt(3) = -(rt + rh)

Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)

With xlRange.Borders(xlEdgeBottom)

If .ColorIndex <> xlAutomatic Then

If .ColorIndex = 3 Then

pLineObj.color = acRed

ElseIf .ColorIndex = 4 Then

pLineObj.color = acGreen

ElseIf .ColorIndex = 5 Then

pLineObj.color = acBlue

ElseIf .ColorIndex = 6 Then

pLineObj.color = acYellow

ElseIf .ColorIndex = 8 Then

pLineObj.color = acCyan

ElseIf .ColorIndex = 9 Then

pLineObj.color = acMagenta

End If

End If

If .Weight = xlThin Then

pLineObj.ConstantWidth = 0

ElseIf .Weight = xlMedium Then

pLineObj.ConstantWidth = 0.35

ElseIf .Weight = xlThick Then

pLineObj.ConstantWidth = 0.7

End If

End With

End If

If xlRange.Borders(xlEdgeRight).LineStyle <> xlNone And (xlRange.Column >= xlRange.MergeArea.Column + xlRange.MergeArea.Columns.Count - 1) Then

pPt(0) = rl + rw: pPt(1) = -(rt + rh)

pPt(2) = rl + rw: pPt(3) = -rt

Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)

With xlRange.Borders(xlEdgeRight)

If .ColorIndex <> xlAutomatic Then

If .ColorIndex = 3 Then

pLineObj.color = acRed

ElseIf .ColorIndex = 4 Then

pLineObj.color = acGreen

ElseIf .ColorIndex = 5 Then

pLineObj.color = acBlue

ElseIf .ColorIndex = 6 Then

pLineObj.color = acYellow

ElseIf .ColorIndex = 8 Then

pLineObj.color = acCyan

ElseIf .ColorIndex = 9 Then

pLineObj.color = acMagenta

End If

End If

If .Weight = xlThin Then

pLineObj.ConstantWidth = 0

ElseIf .Weight = xlMedium Then

pLineObj.ConstantWidth = 0.35

ElseIf .Weight = xlThick Then

pLineObj.ConstantWidth = 0.7

End If

End With

End If

If xlRange.Borders(xlEdgeTop).LineStyle <> xlNone And xlRange.top = 1 Then

pPt(0) = rl + rw: pPt(1) = -rt

pPt(2) = rl: pPt(3) = -rt

Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)

With xlRange.Borders(xlEdgeTop)

If .ColorIndex <> xlAutomatic Then

If .ColorIndex = 3 Then

pLineObj.color = acRed

ElseIf .ColorIndex = 4 Then

pLineObj.color = acGreen

ElseIf .ColorIndex = 5 Then

pLineObj.color = acBlue

ElseIf .ColorIndex = 6 Then

pLineObj.color = acYellow

ElseIf .ColorIndex = 8 Then

pLineObj.color = acCyan

ElseIf .ColorIndex = 9 Then

pLineObj.color = acMagenta

End If

End If

If .Weight = xlThin Then

pLineObj.ConstantWidth = 0

ElseIf .Weight = xlMedium Then

pLineObj.ConstantWidth = 0.35

ElseIf .Weight = xlThick Then

pLineObj.ConstantWidth = 0.7

End If

End With

End If

Set pLineObj = Nothing

End Sub

'文字处理

Sub AddText(ByRef BlockObj As ACADBlock, ByVal xlRange As Range)

If xlRange.Text = "" Then Exit Sub

Dim rl As Double

Dim rt As Double

Dim rw As Double

Dim rh As Double

rl = xlRange.Left / 2.835

rt = xlRange.top / 2.835

rw = xlRange.MergeArea.Width / 2.835

rh = xlRange.MergeArea.Height / 2.835

Dim iPt(0 To 2) As Double

iPt(0) = rl: iPt(1) = -rt: iPt(2) = 0

Dim mTextObj As ACADMText

Set mTextObj = BlockObj.AddMText(iPt, rw, xlRange.Text)

Dim tPt As Variant

If xlRange.VerticalAlignment = xlTop And (xlRange.HorizontalAlignment = xlLeft Or xlRange.HorizontalAlignment = xlGeneral) Then

mTextObj.AttachmentPoint = acAttachmentPointTopLeft

mTextObj.InsertionPoint = iPt

ElseIf xlRange.VerticalAlignment = xlTop And xlRange.HorizontalAlignment = xlCenter Then

mTextObj.AttachmentPoint = acAttachmentPointTopCenter

tPt = ThisDraWing.Utility.PolarPoint(iPt, 0, rw / 2)

ElseIf xlRange.VerticalAlignment = xlTop And xlRange.HorizontalAlignment = xlRight Then

mTextObj.AttachmentPoint = acAttachmentPointTopRight

tPt = ThisDraWing.Utility.PolarPoint(iPt, 0, rw)

ElseIf xlRange.VerticalAlignment = xlCenter And (xlRange.HorizontalAlignment = xlLeft _

Or xlRange.HorizontalAlignment = xlGeneral) Then

mTextObj.AttachmentPoint = acAttachmentPointMiddleLeft

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh / 2)

ElseIf xlRange.VerticalAlignment = xlCenter And xlRange.HorizontalAlignment = xlCenter Then

mTextObj.AttachmentPoint = acAttachmentPointMiddleCenter

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh / 2)

tPt = ThisDraWing.Utility.PolarPoint(tPt, 0, rw / 2)

ElseIf xlRange.VerticalAlignment = xlCenter And xlRange.HorizontalAlignment = xlRight Then

mTextObj.AttachmentPoint = acAttachmentPointMiddleRight

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh / 2)

tPt = ThisDraWing.Utility.PolarPoint(tPt, 0, rw / 2)

ElseIf xlRange.VerticalAlignment = xlBottom And (xlRange.HorizontalAlignment = xlLeft _

Or xlRange.HorizontalAlignment = xlGeneral) Then

mTextObj.AttachmentPoint = acAttachmentPointBottomLeft

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh)

ElseIf xlRange.VerticalAlignment = xlBottom And xlRange.HorizontalAlignment = xlCenter Then

mTextObj.AttachmentPoint = acAttachmentPointBottomCenter

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh)

tPt = ThisDraWing.Utility.PolarPoint(tPt, 0, rw / 2)

ElseIf xlRange.VerticalAlignment = xlBottom And xlRange.HorizontalAlignment = xlRight Then

mTextObj.AttachmentPoint = acAttachmentPointBottomRight

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh)

tPt = ThisDraWing.Utility.PolarPoint(tPt, 0, rw)

End If

mTextObj.InsertionPoint = tPt

Set mTextObj = Nothing

End Sub

html字体重叠的原因,PPT输入文字的时候字重叠是怎么回事呢？相关推荐

  1. 计算机打竖字体,告诉你Photoshop怎么输入竖排的文字

    电脑现已成为我们工作.生活和娱乐必不可少的工具了,在使用电脑的过程中,可能会遇到Photoshop怎么输入竖排的文字的问题,如果我们遇到了Photoshop怎么输入竖排的文字的情况,该怎么处理怎么才能 ...

  2. Mastercam输入文字显示问号解决方法

    Mastercam 是一款出自美国CNC Software Inc.公司之手的实用型PC端CAD/CAM软件,Mastercam ,为用户带来二维绘图.三维实体造型.曲面设计.体素拼合.数控编程.刀具 ...

  3. php输入文字不显示,ps写了文字为什么不显示 ps里输入文字不显示的四个原因及解决方法...

    photoshop输入文字不显示,文字看不到怎么办?在使用ps时,经常要输入文字,有时可能会遇到,输入文字会没有显示出来,或是只有一个黑点的情况,这是什么原因造成的?应该如何解决呢?今天,小编为大家带 ...

  4. excel单元格一分为二还要输入文字，不能编辑是什么原因？

    把excel单元格一分为二,并且能够在斜线上下都能够输入文字,就如下图: 这种形式,在我们制作表格的时候应该经常会用到,那么这样是如何操作得到的呢?今天和大家分享两种操作方法,一起来看一下吧! 首先, ...

  5. WPS文字给字体添加纹理效果快速改变输入文字的颜色

    文档中的文字有些单调,苍白,如果想要为其做出其它的效果,最快捷的方法就是改变其颜色,比如可以插入一些艺术字的效果等等.学完本节之后,你就可以给字体添加任意纹理效果了,另外整理了与之相关的问答,希望对大 ...

  6. Mac office ppt无法正常输入文字的问题解决方案

    Mac office ppt无法正常输入文字的问题解决方案 参考文章: (1)Mac office ppt无法正常输入文字的问题解决方案 (2)https://www.cnblogs.com/tsin ...

  7. vue动态设置文字布局方式_VUE+Canvas实现输入文字生成对应的字体图片小功能

    你是不是经常浏览字体网站的时候,发现他们的"字体生成器"和预览功能很好奇,为什么输入框输入文字之后,点击预览,下面都会修改对应的字体内容,以便达到了没有安装字体也可以预览这个字体效 ...

  8. html文本框超出范围,ppt出现文本框中输入文字超出文本框范围的详细操作

    今天小编讲解了在ppt出现文本框中输入文字超出文本框范围步骤,下文就是关于ppt出现文本框中输入文字超出文本框范围的教程,一起来学习吧. ppt出现文本框中输入文字超出文本框范围的详细操作 首先,打开 ...

  9. VUE+Canvas实现输入文字生成对应的字体图片小功能

    你是不是经常浏览字体网站的时候,发现他们的"字体生成器"和预览功能很好奇,为什么输入框输入文字之后,点击预览,下面都会修改对应的字体内容,以便达到了没有安装字体也可以预览这个字体效 ...

  10. WPS office文档 为何输入文字不显示

      安装的WPS专业版输入文字却不显示,其原因有以下几点:   1.字体颜色设置的跟背景颜色一致,所以直接修改字体颜色即可. 2. 输入的文字被隐藏了.按下[Ctrl+D]组合快捷键或者单击右键后选择 ...

最新文章

  1. 修改系统density适配
  2. 皮一皮：你有没有为中国大数据力量做一份贡献！
  3. Codeforces 1201
  4. 自然语言处理太难？按这个方式走，就是砍瓜切菜！
  5. 基于 flyweight 的格式化文本处理的 Boost.Flyweight 示例
  6. 运营商市场定位决定移动互联网的成败
  7. win10电脑黑屏只有鼠标箭头_win7开机黑屏只有鼠标怎么办，我来教你解决
  8. CSP2021提高组复赛解析
  9. 在命令行下对ntfs分区文件夹权限的设置
  10. IDEA建立Spring MVC Hello World 详细入门教程
  11. JAVA快速排序算法实现
  12. 三星笔记文件存储路径_《那些年JavaWeb踩过的坑》ssh框架整合配置文件路径（错误笔记）...
  13. 从零到一实现一个CNI
  14. mysql 安装gbk字符_mysql安装gbk字符集
  15. nuc8 黑苹果_NUC Hades Canyon (NUC8) 黑苹果（Hackintosh）安装指南
  16. 服务器上线运行正常但不能上网,网线是好的，插笔记本正常上网，插在服务器上却不能上网的解决方法...
  17. 30005 rust_RUSTJKD超级防锈涂料
  18. AD如何显示贴片数值并打印
  19. 神经网络量化----吐血总结
  20. CSS的三种布局方式

热门文章

  1. hudi系列-旧文件清理（clean）
  2. 10.5 Vue电商后台管理完善--订单详情页面显示商品信息，添加备注
  3. VirtualBox中不能正常使用OpneGL的问题
  4. tplink 无线打印服务器,tplink打印服务器设置
  5. ALexa网站排名查询
  6. 使用elasticSearch实现以图搜图
  7. 禾瘦美学馆，不是谁NB谁做，是谁开店谁NB
  8. 3D动画在线播放工具-3dplayer功能演示
  9. PostgreSQL 视图
  10. 安装office2010失败，提示因为安装了office2010早期试用版本或在安装过程中出错