找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 12393|回复: 99

[已解决] 大家合力写个开源的EXCEL-CAD如何

[复制链接]
发表于 2009-1-9 19:39:16 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
如题
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 593个

财富等级: 财运亨通

发表于 2013-6-7 11:35:15 | 显示全部楼层
ayl1004 发表于 2013-6-7 11:26
当然,如果你已经搞定了,就没必要继续发源码,反正我也不需要。

取消限制,去看看
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 1 反对 0

使用道具 举报

发表于 2009-1-9 21:02:55 | 显示全部楼层
不是已经有了吗
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2009-1-9 21:06:19 | 显示全部楼层
好用的要注册收费,不爽,干脆自己练练手
http://www.mcxb.com/MachineCAD/AutoCad/AutoCadJiQiao/50334.html
一、前言

---- Microsoft Excel 软件具有十分强大的制表、表格计算等功能,是普通人员常用的制表工具。可以通过其内嵌的VBA语言可以控制Microsoft Excel 的整个操作过程。

---- AutoCAD是由AutoDesk公司的工程绘图软件,是CAD市场的主流产品,功能十分强大,是工程制图人员常用的软件之一。AutoDesk公司从R14版以后,为其提供了VBA语言接口。

---- 在工程制图中,常常需要在图中插入绘制表格,一般有两种方法。其一,是利用剪贴板,将Microsoft Excel表格拷贝至剪贴板中,然后打开AutoCAD文件,再将剪贴板中的文件粘贴至所需位置。这种方法十分简单,但有其固有的缺点。①在保存文件必须将.xls和.dwg文件保存在一起,一旦缺少excel环境,则再对表格继续修改。②同时打开多个表格操作,需要占据较大的内存空间。③文件体积变得很大,表格有时在.dwg文件中以图标形式显示,不便于观察。

---- 第二种方法,即利用Microsoft Excel、AutoCAD都提供的VBA功能,编制程序进行转换,将Microsoft Excel表格按原来样子转换,即把Microsoft Excel表格中的文字和线条信息全部读取出来,在AutoCAD文件里按照一一对应的方式写出来,确保转换后的表格与原表格一致。这样彻底避免了前种方法的缺点,便于表格内容编辑。本文着重介绍此方法。

---- 二、表格转换工作机理分析及具体实现方法

---- 1.表格转换工作机理分析

---- 在制表过程中,经常遇到两个概念,表和方格。

---- 在Microsoft Excel中,与表对应的对象是工作表(Sheet或Worksheet),与每一个表格方格相对应的对象是单元格区域(range),它可以仅包括一个单元格(cell),也可以由多个单元格合并而成。

---- 在AutoCAD中,没有与表对应的对象,但表可以理解由若干条线和文字对象组合而成。

---- 根据上述分析,可以发现如下的转换方法:

---- 读取Microsoft Excel文件中的最小对象----单元格区域(range)的主要信息---线条和文字,然后在AutoCAD文件里在指定图层、位置画线条,书写文字。通过循环,遍历所有单元格区域(range),边读边写,最终完成表格的转换。转换过程中,保持线条、文字及其相关属性不发生改变。

---- 下面就转换工作的两个主要对象表格线条和表格文字进行讨论。

---- 2、表格线条的转换

---- Microsoft Excel 中内嵌的VBA为我们获取Excel文件信息提供了极大便利。通常,通过访问range对象,可以获得许多信息。访问分析表格的属性应从分析range开始。每一个range包括许多对象和属性,例如,font对象可以返回range的字体信息。通过遍历,即可获得整个表格信息。获取表格信息的目的在于准确地按照位置画表格线,同时确定文字位置。

---- 在获取表格信息时,存在一个最佳算法问题。以下就画线问题为例,阐明问题和解决方法。

---- 假设表格由a(a>=1)行b(b>=1)列组成,x,y为循环变量, 表格完全由单元格组成,由于在每个单元格都有4条边,让x从1开始循环到a, 再y从1开始循环到b,读取每个单元格的4条边,会读取a*b*4次,重复读取a*b*2次。当x=1时,读取上边;当y=1时读取,左边,其余情况读取右边,下边。共读取a+b+ a*b*2次。以3行4列为例,共读取3+4+3*4*2=31次,与实际表格的边数相同,没有重复读取。

---- 对合并单元格信息的读取是个难点。因为如果按照单元格的位置依次读取,那么由a行b列个单元格(cell)合并而成的单元格区域(range)仅有4条边,采用上述计算方法,需要读取a+b+ a*b*2次,重复读取a+b+ a*b*2 - 4次。以以3行4列为例,共读取3+4+3*4*2=31次,重复读取31 - 4=27次。算法有重复。如果按照行号,列号读取,合并单元格的行号、列号只有一个,其值为最靠左、靠上的那个单元格的行号、列号。例如,将A2:E5的单元格合并后,其行号为2,列号为A。这样由多个合并单元格组合后的表格行号、列号有间断,不连续,无法进行循环读取信息。笔者通过研究发现,函数 address()和单元格的mergearea属性可以获得合并单元格的准确信息。具体方法为:读取cells(x,y)单元格时,用 address()判断包含cells(x,y)单元格的合并单元格区域c.mergearea的绝对地址,如果前4个字符与cells(x,y) 单元格的地址相同,为cells(x,y)单元格为合并单元格区域最靠上、靠左的那个合并单元格,读取其4条边信息,否则不读取。这样,彻底避免了重复读取,同时提高了整个读取和画线速度。

---- 在AutoCAD中,线条有多种,考虑能够方便控制线条属性,选用了多义线。具体命令如下: RetVal = object.AddLightWeightPolyline(VerticesList)

---- 下面的程序演示表格线条读取和画表格线的具体过程。

Sub hxw()
Dim a as interger ‘表格的最大行数
Dim b as interger ‘表格的最大列数
Dim xinit as double ‘插入点x坐标
Dim yinit as double ‘插入点y坐标
Dim zinit as double ‘插入点z坐标
Dim xinsert as double ‘当前单元格的左上角点的x左标
Dim yinsert as double ’当前单元格的左上角点的y左标
Dim ptarray (0 to 2) as double
Dim x as integer
Dim y as integer
For x =1 to a
For y=1 to b
Set c = xlsheet.Range(zh(y) + Trim(Str(x)))
‘以行号、列号获得单元格地址
Set ma = c.MergeArea
‘求出单元格C的合并单元格地址
If Left(Trim(ma.Address), 4) = Trim(c.Address) Then
假如c.mergearea的绝对地址,如果前4个字符与c单元格的地址相同
xl = "A1:" + ma.Address
xh = xlsheet.Range(ma.Address).Width
yh = xlsheet.Range(ma.Address).Height
Set xlrange = xlsheet.Range(xl)
xinsert = xlrange.Width - xh
yinsert = xlrange.Height - yh
xpoint = xinit + xinsert
ypoint = yinit - yinsert
If x = 1 Then
If ma.Borders(xlEdgeTop).LineStyle
<> xlNone Then
ptArray(0) = xpoint
‘第一点坐标(数组下标 0 and 1)
ptArray(1) = ypoint
ptArray(2) = xpoint + xh
‘第二点坐标(数组下标 2 and 3)
ptArray(3) = ypoint
End If


Lineweight lwployobj, ma.Borders(xlEdgeTop).Weight
End If
If ma.Borders(xlEdgeBottom).LineStyle
< > xlNone Then
ptArray(0) = xpoint + xh
‘第三点坐标(数组下标 0 and 1)
ptArray(1) = ypoint - yh
ptArray(2) = xpoint
‘第四点坐标(数组下标 2 and 3)
ptArray(3) = ypoint – yh
Lineweight lwployobj,
ma.Borders(xlEdgeBottom).Weight
End If
If y = 1 Then
If ma.Borders(xlEdgeLeft).LineStyle
< > xlNone Then
ptArray(0) = xpoint
‘第四点坐标(数组下标 0 and 1)
ptArray(1) = ypoint - yh
ptArray(2) = xpoint
‘第一点坐标(数组下标 2 and 3)
ptArray(3) = ypoint
End If
Lineweight lwployobj, ma.Borders(xlEdgeLeft).Weight
End If
If ma.Borders(xlEdgeRight).LineStyle
< > xlNone Then
ptArray(0) = xpoint + xh
‘第二点坐标(数组下标 0 and 1)
ptArray(1) = ypoint
ptArray(2) = xpoint + xh
‘第三点坐标(数组下标 2 and 3)
ptArray(3) = ypoint – yh
Lineweight lwployobj,
ma.Borders(xlEdgeRight).Weight
End If
Set lwployobj = moSpace.AddLightWeightPolyline(ptArray)
‘在AutoCAD文件里画线
With lwployobj
.Layer = newlayer.name ‘指定lwployobj所在图层
.Color = acBlue ‘指定lwployobj的颜色
End With
Lwployobj.Update
Next y
Next x
End Sub
‘下面程序控制线条粗细
Sub Lineweight(ByVal line As Object, u As Integer)
Select Case u
Case 1
Call line.SetWidth(0, 0.1, 0.1)
Case 2
Call line.SetWidth(0, 0.3, 0.3)
Case -4138
Call line.SetWidth(0, 0.5, 0.5)
Case 4
Call line.SetWidth(0, 1, 1)
Case Else
Call line.SetWidth(0, 0.1, 0.1)
End Select
End Sub
‘下面程序完成列号转换
Function zh(pp As Integer) As String
If pp < 26 Then
zh = Chr(64 + pp)
Else
zh = Chr(64 + Int(pp / 26)) + Chr(64 + pp Mod 26)
End If
End Function

利用VBA编程实现从EXCEL表到AUTOCAD表转换(2)
-- 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 .AttachmentPoin
t = 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命令提供的属性进行转换,避免了已往修改形文件来进行文字标注的方法,直接控制表格文字字体、大小、下划线、上下脚标,倾斜,加粗等,使每个文字的风格均可以得到很好的控制,极大提高了文字标注的灵活性。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-1-9 23:34:34 | 显示全部楼层
看看能不能用到,先谢谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2009-1-10 18:18:01 | 显示全部楼层

  1. (defun zh (pp /)
  2.   (if (< pp 26)
  3.     (chr (+ pp 64))
  4.     (strcat (chr (+ 64 (fix (/ pp 26))))
  5.             (chr (+ 64 (rem pp 26)))
  6.     )
  7.   )
  8. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-1-12 12:12:18 | 显示全部楼层
VBA毕竟不是CAD的孩子,曾经很疯狂捣鼓,后来发现限制太多,放弃,况其运行速度慢,罢了。

点评

楼主怎么判断cad中vba速度慢呀?官方对比结果,vba比vlisp快,vb最慢了  详情 回复 发表于 2013-6-4 12:36
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2009-1-12 15:47:29 | 显示全部楼层
初步翻译

  1. (defun c:x2cad (/        zh        ExcelApp        Sht        UsedRange
  2.                 a        b        x        y        c        ma        Maddress
  3.                 xl        xh        yh        xinsert        yinsert        xlrange        xinit
  4.                 yinit        range
  5.                )
  6.   (defun zh (pp /)
  7.     (if        (< pp 26)
  8.       (chr (+ pp 64))
  9.       (strcat (chr (+ 64 (fix (/ pp 26))))
  10.               (chr (+ 64 (rem pp 26)))
  11.       )
  12.     )
  13.   )
  14.   (setq        ExcelApp (vlax-get-or-create-object "Excel.Application")
  15.         Sht         (vl-catch-all-apply
  16.                    'vlax-get-property
  17.                    (list (vlax-get-property ExcelApp 'ActiveWorkbook)
  18.                          'ActiveSheet
  19.                    )
  20.                  )
  21.   )
  22.   (setq        UsedRange (vlax-get-property Sht 'UsedRange)
  23.         b          (vlax-get-property
  24.                     (vlax-get-property UsedRange 'Columns)
  25.                     'Count
  26.                   )
  27.         a          (vlax-get-property
  28.                     (vlax-get-property UsedRange 'Rows)
  29.                     'count
  30.                   )
  31.         x          1
  32.         y          1
  33.   )
  34.   (repeat a
  35.     (repeat b
  36.       (setq c  (vlax-get-property
  37.                  usedrange
  38.                  'range
  39.                  (strcat (zh y) (vl-string-left-trim " " (itoa x)))
  40.                )
  41.             ma (vlax-get-property c 'MergeArea)
  42.       )
  43.       (If
  44.         (= (substr (vl-string-trim " " (vlax-get-property ma 'Address))
  45.                    1
  46.                    4
  47.            )
  48.            (vl-string-trim " " (vlax-get-property c 'Address))
  49.         )
  50.          (progn
  51.            (setq Maddress (vlax-get-property ma 'Address)
  52.                  xl          (strcat "A1:" Maddress)
  53.                  range          (vlax-get-property sht 'range maddress)
  54.                  xh          (vlax-get-property range 'width)
  55.                  yh          (vlax-get-property range 'height)
  56.                  xlrange  (vlax-get-property sht 'range xl)
  57.                  xinsert  (- (vlax-get-property xlrange 'width) xh)
  58.                  yinsert  (- (vlax-get-property xlrange 'width) yh)
  59.                  xpoint          (+ xinit yinsert)
  60.                  ypoint          (- yinit yinsert)
  61.            )
  62.          )
  63.       )
  64.       (setq y (1+ y))
  65.     )
  66.     (setq x (1+ x))
  67.   )
  68. )

点评

(vlax-get-property ma 'Address) 提示; 错误: 实参太少  详情 回复 发表于 2013-6-8 13:41
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-12-13 23:34:30 | 显示全部楼层
好像提示:参数类型错误: VLA-OBJECT #<%catch-all-apply-error%>
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-12-20 12:39:29 | 显示全部楼层
确实是很厉害,高手如云呢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1757个

财富等级: 堆金积玉

发表于 2013-5-9 16:34:52 | 显示全部楼层
貌似也不是很好用
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 145个

财富等级: 日进斗金

发表于 2013-5-28 19:53:20 | 显示全部楼层
come on
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2013-6-4 00:24:59 | 显示全部楼层
另外一篇文章
用VB编程实现把Excel表格画到AutoCAD中
http://tengteb.blog.163.com/blog/#m=0&t=1&c=fks_080075083095084071092074084070085087080067085080

这个单位转换比较有意义,留存

'1厘米=566.6666 缇
'1 磅 = 1/72 英寸 = 20 缇, 1 英寸 = 72 磅 = 1440 缇,1 厘米 = 567 缇
'磅是打印度量单位,像素是屏幕度量单位;磅的实际大小是固定的(1/72 英寸),但是像素的大小取决于特定屏幕的分辨率。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3255个

财富等级: 富可敌国

发表于 2013-6-4 12:36:49 | 显示全部楼层
qiaqiadeng 发表于 2009-1-12 12:12
VBA毕竟不是CAD的孩子,曾经很疯狂捣鼓,后来发现限制太多,放弃,况其运行速度慢,罢了。

楼主怎么判断cad中vba速度慢呀?官方对比结果,vba比vlisp快,vb最慢了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 7个

财富等级: 恭喜发财

发表于 2013-6-6 23:46:55 | 显示全部楼层
怎么都没有人响应啊?

点评

继续, 先写一个优化 Cell 边框的函数, 读取 Cell 边框坐标(仅有边框线部分), 将这些坐标构造一个表, 用下面的函数优化后再绘制 **** 本内容被作者隐藏 ****  详情 回复 发表于 2013-6-7 09:01
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2013-6-7 09:01:41 | 显示全部楼层
ayl1004 发表于 2013-6-6 23:46
怎么都没有人响应啊?

继续, 先写一个优化 Cell 边框的函数, 读取 Cell 边框坐标(仅有边框线部分), 将这些坐标构造一个表, 用下面的函数优化后再绘制
[pcode=lisp,true]
;;参数: lst    按行由右至左排列的两两点表 (((xn y 0.) (xn-1 y 0. )) ... ((x2 y 0.) (x1 y 0.)))
;;           或按列由下至上排列的两两点表 (((x yn 0.) (x yn-1 0. )) ... ((x y2 0.) (x y1 0.)))
;;      mod    "X" 行, "Y" 列
;;说明:用于优化读取的 Excel 边线
(defun Fy:Sortln (lst Mod / ptx->l pty->l l l1 l2)
  (defun ptx->l (l1 l2 / x1 x2 x3 x4)
    (mapcar 'set '(x1 x2) (mapcar 'car l1))
    (mapcar 'set '(x3 x4) (mapcar 'car l2))
    (if (equal x1 x4 1e-3);_比较中间点
      (list (car l2) (cadr l1))
      (list l1 l2)
    )
  )
  (defun pty->l (l1 l2 / y1 y2 y3 y4)
    (mapcar 'set '(y1 y2) (mapcar 'cadr l1))
    (mapcar 'set '(y3 y4) (mapcar 'cadr l2))
    (if (equal y2 y3 1e-3);_比较中间点
      (list (car l1) (cadr l2))
      (list l1 l2)
    )
  )
  ;;为提高效采用一次判断,多码些代码
  (setq l   (list (car lst))
lst (cdr lst)
  )
  (if (= mod "X")
    (while lst
      (setq l1 (car lst)
     l2 (car l)
      )
      (if (= (length (setq nl (ptx->l l1 l2))) 2)
(setq l (cons l1 l))
(setq l (cons nl (cdr l)))
      )
      (setq lst (cdr lst))
    )
    (while lst
      (setq l1 (car lst)
     l2 (car l)
      )
      (if (= (length (setq nl (pty->l l1 l2))) 2)
(setq l (cons l1 l))
(setq l (cons nl (cdr l)))
      )
      (setq lst (cdr lst))
    )
  )
  l
)
[/pcode]

点评

本来想和你合力搞定的,可我又看不到,那我也发部分代码  详情 回复 发表于 2013-6-7 11:20
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-29 02:34 , Processed in 0.482463 second(s), 70 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表