回答：用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

HTML5字体设置重影,Word怎么设置字体重影相关推荐

  1. Itext设置导出word文件的字体

    首先,要导入Itext的三个jar包:iText-2.1.7.jar,itext-rtf-2.1.7.jar,iTextAsian.jar: 其次,Itext里面设置导出word文件的字体,用RtfF ...

  2. html5 主标题副标题,word如何设置正副标题

    很多初学者在学习word的时候会遇到如何添加标题的困扰,或者想要改变一下标题的位置格式,那么下面就由学习啦小编给大家分享下word设置正副标题的技巧,欢迎大家来到学习啦学习. word设置正副标题的方 ...

  3. matlab word 字体,matlab插入word后修改字体

    我目前用matlab写入word,默认字体是宋体,我想修改字体,应该怎么办呢? Content = Document.Content; Content.Start=0; Content.Text=st ...

  4. html设置字体仿宋GB2312,Word怎么设置仿宋体显示为仿宋GB2312字体?

    做好的Word文档在系统升级后,或更换电脑后,原来设置的字体突然都变了,排版效果全乱,找不出问题在哪,挨个修改,不甚其烦.在经历过这磨难后,我决定刨根问底.才发现原来是XP系统和win7之间字体不一样 ...

  5. 玩转WORD字体设置：WORD字间距怎么调整，WORD字体怎么调大等

    WORD作为最好的文字处理软件之一,在日常办公中,是不可或缺的.而作为文字处理软件,WORD关于字体的操作尤为重要.今天,奇点来临小编就和大家分享下WORD字体的一些技巧,如果您觉得有用,可以转发给朋 ...

  6. 如何把Word英文默认字体设置成Times NewRoman汉字设置为宋体

    如何把Word英文默认字体设置成Times NewRoman汉字设置为宋体 https://jingyan.baidu.com/article/e75057f2ddef91ebc91a89f4.htm ...

  7. word字体设置：如何为常用字体设置快捷键

    在使用Word撰稿时,如果对文中使用的字体做了硬性的要求,那么,我们每次就需要手工修改字体.而在编辑某些Word文档过程中,如果对文中使用的字体没有做硬性的要求,那么,在设置字体时,我们通常会设置为自 ...

  8. poi word 表格设置居中、左对齐缩进、边框、字体

     个人记录使用 1.表格居中与左对齐缩进二选一 2.边框设置可参考 POI 设置Word表格边框.表格文字水平居中 package com.gsafety.anjian.analysis.util; ...

  9. html5字体em,html5字体设置图片生成QQ签名字体样式

    特效描述:html5字体设置 图片生成 QQ签名字体.html5 canvas字体设置生成图片字体样式,QQ签名字体样式,进击のXX生成器支持字数无限. 代码结构 1. HTML代码 内容: 文字背景 ...

最新文章

  1. Science：微生物组“淘金热”，从人体中发现新型抗菌剂
  2. GARFIELD@01-18-2005
  3. 移动界面设计点滴：工欲善其事，必先利其器[转]
  4. 深度学习 load_data_fashion_mnist
  5. JavasSript实现秒转换为“天时分秒”控件和TDD测试方法应用
  6. java面试常见问题
  7. pytorch常用函数API简析与汇总——以备查询
  8. python窗口显示表格_Python爬虫之GUI图表
  9. 分布式选举协议：Paxos
  10. 区域转换为二值图像_零基础一文读懂AI深度学习图像识别
  11. 动机的寓言：孩子为谁在玩
  12. C++并发编程之std::future
  13. 【转】Java中的关键字 transient
  14. SQL Server常用查询指令
  15. Unity3D 官方案例实现类似红警的移动
  16. Python查询mysql返回序列化数据
  17. TokenInsight对话首席——揭秘7*24小时用数学解码交易的神秘玩家：量化交易者
  18. Docker：（二）docker安装部署及优化详解
  19. OCR技术（大批量生成文字训练集）
  20. docker-compose部署Redis-Cluster集群

热门文章

  1. 从图片到涂鸦：高品质涂鸦的自动生成
  2. 计算机显卡设置方法,显卡在哪里设置 显卡设置方法【详细介绍】
  3. 面试官问你有什么优点/缺点该如何回答
  4. 别让你20多岁的活法，毁掉你30岁后的人生
  5. Simulink如何添加模块到Library Browser
  6. [LED]如何配置LCD背光和LED，调试方法
  7. 30分钟简易复刻元气骑士地图生成系统
  8. 关于微信授权登录的用户取消-2的问题
  9. JS如何改变元素内容？
  10. 又一家中国IC进军IPO：年出货上亿颗，在做Type-C 8K芯片