文字大小设置不合适吧,在粘贴到CAD中时应该有一个对话框提示输入字体大小,改一下试试。
CAD小苗 微信公众号 新浪博客
用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