明经CAD_VBA论坛整理（7）
22. 如何得到objectDBX及其帮助？
23请教CAD屏幕选取一个块后,怎样获得它的属性,并存放在一个数组里.
必须先定义一个二维数组
Dim AttArray(1, UBound(vaattributes)) As Variant
然后在下面的循环中把属性填充到数组中：
For J = 0 To UBound(vaattributes)
&&&&&&&&&&&&AttArray(0,J)=vaattributes(J).TagString
&&&&&&&&&&&&AttArray(1,J)
= attvars(J).TextString
&&&&&&&&Next
24. 哪位大侠知道，怎么取得任意图形的中心点坐标！
如果是指质心的话，你可以先将图形做成面域（region）
然后再找这个面域的centroid属性即可。
但要说明的是，这个centroid是个二维点，你只能得到centroid（0）和centroid（1）两个量。其余的应该好办了吧。
如果不是质心，可以用getboundary方法来找图形的几何中心
25测量坐标与屏幕坐标的转换
us1 = ThisDrawing.GetVariable("userr1")
us2 = ThisDrawing.GetVariable("userr2")
us3 = ThisDrawing.GetVariable("userr3")
ThisDrawing.GetVariable("useri5") =
666请教：userr1，userr2，userr3，userri5这几个系统变量有什么用？
userr1，userr2，userr3，userri5
按顺序排：比例尺，左下角x坐标，左下角y坐标，高程比例尺
26VBA回车响应的问题
我想在对话框显示的时候，按回车就立即响应COMMAND1的CLICK事件。
我写的程序为：
&&Private Sub
UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 13 Then
UserForm1.Hide
Sub运行时，按回车无响应。怎样才能按回车就立即响应COMMAND1的CLICK事件？
请各位多多指教。
将Command1的Default属性更改为True。这样，只要是你在编辑框中按了回车，就可以默认Command1中的点击事件。
27.是根据VBA教材的代码改的批量裁剪程序
Sub Trim()
acadapp As AcadApplication
acaddoc As AcadDocument
acadapp = connectcad(acadapp)
acaddoc = acadapp.ActiveDocument
&&&&AppActivate
acadapp.Caption '让CAD得到焦点
Pnt1 As Variant
entObj1 As AcadEntity
&&&&acaddoc.Utility.GetEntity
entObj1, Pnt1, "选择修剪边界："
det1 As String
= axEnt2lspEnt(entObj1)
Pnt2 As Variant
entObj2 As AcadEntity
sle1 As AcadSelectionSet
Error Resume Next
sle1 = acaddoc.SelectionSets.Item("sle1")
&&&&sle1.Clear
&&&&Err.Clear
sle1 = acaddoc.SelectionSets.Add("sle1")
&&&&acaddoc.Utility.Prompt
"选择需要修剪的对象" & Chr(13)
&&&&sle1.SelectOnScreen
= acaddoc.Utility.GetPoint(, "选择修剪方向")
det2 As String
Each entObj2 In sle1
= GetDoubleEntTable(entObj2, Pnt2
&&&&acaddoc.SendCommand
"_trim" & vbCr & det1
& vbCr & vbCr &
det2 & vbCr & vbCr
command_str As String
&&&&command_str
= Chr(3) & Chr(3)
&&&&acaddoc.SendCommand
command_str
&&&&acaddoc.Utility.Prompt
"修剪完成!"
&&&&acaddoc.SendCommand
command_str
acadapp = Nothing
'转换双元表的函数
Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As
Variant) As String
entHandle As String
&&&&entHandle
= entObj.Handle
&&&&GetDoubleEntTable
= "(list(handent " & Chr(34) &
entHandle & Chr(34) & _
&&&&&&&&&&&&&&&&&&&&
")(list " & Str(Pnt(0)) &
Str(Pnt(1)) & Str(Pnt(2)) &
End Function
'转换点的函数
Public Function axPoint2lspPoint(Pnt As Variant) As String
&&&&axPoint2lspPoint
= Pnt(0) & "," & Pnt(1)
& "," & Pnt(2)
End Function
'转换图元函数
Public Function axEnt2lspEnt(entObj As AcadEntity) As String
entHandle As String
&&&&entHandle
= entObj.Handle
&&&&axEnt2lspEnt
= "(handent " & Chr(34) & entHandle
& Chr(34) & ")"
End Function
Function connectcad(acadapp As AcadApplication) As AcadApplication
'连接AUTOCAD
On Error Resume
'与autocad通信&
acadapp = GetObject(, "AutoCAD.Application")
&&&&&&&&Err.Clear
&&&&&&&&Set
acadapp = CreateObject("AutoCAD.Application")
&&&&&&&&If
&&&&&&&&&&&&MsgBox
Err.Description
&&&&&&&&&&&&Exit
&&&&&&&&End
Set connectcad = acadapp
End Function
Private Sub Form_Initialize()
你的程序本身有问题：
在选择修剪方向时，其实你只认定了一个点Pnt2，然后你就使用该点组成了修剪的双元表，这样的话，对于被修剪对象来说，可能会产生点取的点在外部的问题，因为系统认定的点取的位置是Pnt2到被修剪对象上的垂直点的位置。
要达到效果，应该是：
点取一个点Pnt2后，把多段线向内偏移一小段距离，然后逐条遍历被修剪对象的选择集，求选择集中的对象与偏移的对象的交点，再通过交点来组成双元表，这样的话，应该可以解决。
双元表也就是指在进行一些对象操作时对位置有要求时使用数据格式
我用sendcommand的_trim命令，经常剪不断，怎么办？
是从“实用函数”里学到的方法，做了一些修改：
Public Sub Trim(ByVal cutLine1 As AcadLine, ByVal cutLine2 As
AcadLine, _
&&&&&&&&&&&&&&&&ByVal
entSP As AcadSpline, ByVal optCode As String)
cutLine2是_trim的两个边界线，endSP是要剪的样条曲线。
det1, det2 As String
= axEnt2lspEnt(cutLine1)
= axEnt2lspEnt(cutLine2)
det3, det4 As String
= GetDoubleEntTable(entSP, entSP.GetControlPoint(0))
= GetDoubleEntTable(entSP,
entSP.GetControlPoint(entSP.NumberOfControlPoints - 1))
optCode = "first" Then
&&&&&&&&ThisDrawing.SendCommand
"_trim" & vbCr & det2
& vbCr & _
&&&&&&&&&&&&
vbCr & det4 & vbCr
&&&&&&&&GoTo
optCode = "last" Then
&&&&&&&&ThisDrawing.SendCommand
"_trim" & vbCr & det1
& vbCr & _
&&&&&&&&&&&&&&vbCr
& det3 & vbCr &
&&&&&&&&GoTo
&&&&ThisDrawing.SendCommand
"_trim" & vbCr & det1
& vbCr & det2 &
&&&&&&&&&&vbCr
& vbCr & det3 &
vbCr & det4 & vbCr
'转换双元表的函数
Private Function GetDoubleEntTable(entObj As AcadEntity, Pnt As
Variant) As String
entHandle As String
&&&&entHandle
= entObj.Handle
&&&&GetDoubleEntTable
= "(list(handent " & Chr(34) &
entHandle & Chr(34) & _
&&&&&&&&&&&&&&&&&&&&
")(list " & Str(Pnt(0)) &
Str(Pnt(1)) & Str(Pnt(2)) &
End Function
'转换点的函数
Private Function axPoint2lspPoint(Pnt As Variant) As String
&&&&axPoint2lspPoint
= Pnt(0) & "," & Pnt(1)
& "," & Pnt(2)
End Function
'转换图元函数
Private Function axEnt2lspEnt(entObj As AcadEntity) As String
entHandle As String
&&&&entHandle
= entObj.Handle
&&&&axEnt2lspEnt
= "(handent " & Chr(34) & entHandle
& Chr(34) & ")"
End Function
作用主要是把样条曲线其中两个拟合点之间的一段剪出来，但在弯比较急的地方经常剪不断，造成出错。请问怎么办？
29关于split()函数的问题
我在尝试用CommonDialog打开多个文件时，为分离各个文件名，用了split()函数，但结果却怎么也不对。具体代码如下：
Dim NewFileName() As String
CommonDialog1.filter = "Drawing Files(*.dwg)|*.dwg|"
& "All Files(*.*)|*.*|"
CommonDialog1.flags = cdlOFNAllowMultiselect Or
cdlOFNExplorer
CommonDialog1.FilterIndex = 1
CommonDialog1.DialogTitle = "选择文件..."
CommonDialog1.InitDir = "e:\"
CommonDialog1.ShowOpen
NewFileName() = Split(CommonDialog1.FileName,
'因为用监视窗口察看CommonDialog1.FileName各文件之间用间隔，但此时的NewFileName(0)
=CommonDialog1.FileName，即split()函数没起作用，但若我
定义CommonDialog1.FileName="E:\pb.dwgpb",则split()函数则
起作用，此时NewFileName()
为正确结果。不知大家能否帮我解决这一难题，不胜感激。
NewFileName() = Split(CommonDialog1.FileName, Chr(0))
30我有一个问题,就是"在AUTOCAD中用VBA或Visual
LISP中写一个程式,能在AUTOCAD中选中一个封闭的多义线(在封闭的多义线中有直线,倒圆角,圆弧,角度)按逆时针找出每一个2D坐标,写在一个文本文件里!
我在网上坛子里问了三个月了,十几个人说来说去,都没搞定.
Dim pnt As Variant
Dim ent1 As AcadLWPolyline
Dim ent2 As AcadLWPolyline
Dim ents As Variant
Dim pnts As Variant
Dim cnt As Integer
Dim cor() As Double
Dim i As Integer
Dim txt As String
ThisDrawing.Utility.GetEntity ent1, pnt
pnts = ent1.Coordinates
cnt = (UBound(pnts) + 1) / 2
Debug.Print cnt
ReDim cor(1, cnt) As Double
For i = 0 To UBound(pnts) Step 2
cor(0, i / 2) = ent1.Coordinates(i)
cor(1, i / 2) = ent1.Coordinates(i + 1)
ents = ent1.Offset(10)
Set ent2 = ents(0)
If ent2.Area & ent1.Area Then
txt = "逆时针方向，其逆时针坐标如下："
For i = 0 To UBound(cor, 2) - 1
txt = txt & vbCr & cor(0, i)
& "," & cor(1, i)
txt = "线为顺时针方向，已经转换为逆时针的坐标如下："
For i = UBound(cor, 2) - 1 To 0 Step -1
txt = txt & vbCr & cor(0, i)
& "," & cor(1, i)
For i = 0 To UBound(ents)
ents(i).Delete
MsgBox txt
31如何在VB中开关非当前层？
Sub SetLayerOff()
LayerName As String
&&&&LayerName
Error Resume Next
&&&&Err.Number
MyLayer As AcadLayer
MyLayer = ThisDrawing.Layers(LayerName)
Err.Number = 0 Then
&&&&&&&&ThisDrawing.Layers(LayerName).LayerOn
&&&&&&&&ThisDrawing.Utility.Prompt
vbCrLf & " 图层“" & LayerName
& "”已经被关闭。"
&&&&&&&&ThisDrawing.Utility.Prompt
vbCrLf & " 图层“" & LayerName
& "”不存在。"
已投稿到：
以上网友发言只代表其个人观点，不代表新浪网的观点或立场。最佳Visual LISP及VBA for AutoCAD2000程序123例 - 读书网|
　|　　|　
　|　　|　　|　　|　　|　　|　　|　
图书搜索：
全部ISBN书名作者
丛编项出版社主题项
&全部图书&可读图书&可购图书
最佳Visual LISP及VBA for AutoCAD2000程序123例 - 书籍详细信息
查看同类图书：>>>>>>>>
最佳Visual LISP及VBA for AutoCAD2000程序123例
【作　者】：编著
【丛编项】：
【装帧项】：平装 26cm＋光盘1片 / 313
【出版项】： / 1999-09
【ISBN号】：4 /
【原书定价】：￥45.00　
【主题词】：－软件开发 软件开发－
【图书简介】　　本书从编程技巧和实际应用角度出发，介绍Auto CAD开发环境及其最新发展，力求避免大篇幅论理，而是使用大量示例与说明，使读者按照示例练习，在实践中掌握Visual LISP和VBA for AutoCAD的功能。书中程序均在Auto CAD 2000中运行通过，绝大部分程序对早期版本也适用，并附有光盘一片。书中解答了常见的问题，附录对Visua lLISP和VBA for AutoCAD进行了对比，并列出了Auto CAD 2000的主要文件类型和快捷键。本书可提供中高级编程人员使用。-
【本书目录】&&&&第一章
AutoCAD开发环境及其最新发展
1.1AutoCAD早期版本的开发环境
1.1.1AutoLISP
1.2内部集成VisualLISP
1.3VBA的应用
1.4ObjectARX编程接口功能扩充
1.5Java的支持
VisualLISP实例训练
2.1.1绘制角平分线
2.1.2绘制螺栓
2.1.3根据范例绘图
2.1.4绘制多个圆的中心线
2.1.5绘制两圆交叉公切线
2.1.6局部放大之一
2.1.7局部放大之二
2.1.8绘制带对角线的长方形
2.1.9椭圆转换为弧段
2.1.10线段端点连接
2.1.11绘制齿轮
2.1.12绘制小草
2.1.13绘制网格
2.1.14绘制工字型梁
2.1.15绘制“L”型剖面梁
2.1.16绘制“无限长”水平线和垂直线
2.1.17两线交叉跨越示意
2.1.18绘制平行线
2.1.19绘制管子剖面
2.1.20绘制平板
2.1.21参数化设计阶梯轴
2.1.22圆周开槽
2.1.23绘制任意角的星形
2.1.24绘制与三点相切的圆
2.2.1绘制2D和3D螺旋线
2.2.2绘制3DFace
2.2.3绘制连续弯折的3D管线
2.3图形编辑
2.3.1沿指定角度阵列对象
2.3.2在交点处断开线
2.3.3改变文本内容
2.3.4显示并修改单个实体的属性
2.3.5擦除线段
2.3.6复制对象到指定层
2.3.7沿指定方向多重复制对象
2.3.8复制并旋转对象
2.3.9断开对象
2.3.10双重偏移
2.3.11改进的倒圆角命令
2.3.12连接直线
2.3.13绘制十字交叉路口
2.3.14改变线或弧的线宽
2.4文本标注
2.4.1面积标注
2.4.2转换大小写
2.4.3Mtext转换成Text
2.4.4文本添加下划线
2.4.5绘制带阴影框的文本
2.5尺寸标注
2.5.1标注直线的方向和长度
2.5.2测量并标注弧长
2.5.3“气泡”标注
2.5.4点的坐标标注
2.5.5曲线型旁注线
2.5.6绘制特殊的旁注线
2.6.1创建并插入匿名块
2.6.2改变属性文本高度
2.6.3拆开不定比例的块
2.6.4插入块或外部块
2.6.5块内容列表
2.6.6组合与解散实体
2.6.7再插入同样块
2.7.1将实体颜色改变为随层
2.7.2实体改变到目标层
2.7.3设置拾取对象所在图层为当前层
2.7.4复制到当前层
2.7.5解冻层
2.7.6删除层上的实体
2.7.7隔离层
2.7.8冻结层
2.7.9新建层
2.7.10移动层上的实体
2.7.11保存图层设置
2.8实用工具
2.8.1两线夹角测量
2.8.2矩形面积测量
2.8.3单位转换
2.8.4改进的LIST命令
2.8.5列出绘图环境
2.8.6体积测量
2.8.7实时放大
2.9趣味话题
2.9.1自动计数
2.9.2分形图案
2.9.3数字递增复制
2.9.4画龙和曲线图案
2.9.6绘制松果
2.9.7质数计算器
2.9.8改进的多边形
2.9.9自动产生对话框
VBA实例训练
3.12D绘图与编辑
3.1.1创建点对象
3.1.2绘制多义线
3.1.3绘制一组放射线
3.1.4绘制一组圆
3.1.5绘制剖面线
3.1.6改变实体颜色
3.1.7实时改变线型比例
3.1.8改变多义线的宽度
3.23D造型与编辑
3.2.1创建实心填充区域
3.2.2创建面域
3.2.3创建3D网格
3.2.43D工字梁
3.2.53D旋转
3.2.6编辑3D实体
3.3文件管理
3.3.1新建绘图
3.3.2DWG文件管理器
3.3.3DVB文件加载器
3.4.1创建文本
3.4.2创建多行文本
3.4.3文本、数据的输入与绘图
3.4.4文本查找与替换
3.4.5改变文本的高度
3.5输入输出
3.5.1控制输入
3.5.2打印输出模型空间的绘图
3.5.3打印输出图纸空间的绘图
3.6视图控制
3.6.1拆分视口
3.6.2控制视口
3.6.3定义用户坐标系统
3.7.1新建图层
3.7.2搜索图层
3.7.3图层管理标准化
3.7.4改变图层
3.8实用工具
3.8.1检索图形数据库中的第一个实体
3.8.2计算距离
3.8.3计算面积
3.8.4射线查询
VisualLISP和ActiveX/VbA函数对比
2000主要文件类型
AutoCAD2000的快捷键
【购买本书】
商城名称价格
配送信息优惠活动去看看购买
当天加急送：北京五环以内送货上门：国内178个城市邮寄：全球特快专递：全球
送货上门：辽宁、长春、北京快递、邮政递送：全球
30万春节大礼包连环送，全场7折+满100免运费
当天加急送：北京五环以内送货上门：国内178个城市邮寄：全球特快专递：全球
北京用户69折封顶满99免运费
1、由于网上书店可能根据各种情况随时调整价格，我们的价格信息存在滞后性。以上价格仅作参考，具体以网上书店标示的价格为准。
2、如价格折扣信息和原书定价存在较大误差，可能是该店售书为本书的不同版本或不同装祯形式，请读者自行鉴别。
3、对如何网上购书存在疑问，请点击上面购书指南链接查询。
【借阅本书】
图书馆备注借阅
相关资源：
在OCLC世界联合图书目录中
【特价团购】
特惠：含全国各大出版社数十万种教材和图书，折扣低，量大还有更多优惠！
高效：采购方便、配货、发货方便快捷！
零运费：享受全国零运费！
承接标准：单本订购50册以上，同时满足订购金额1500元以上
联系方式：郝老师 ，服务时间:10：00-17:00(周一至周五)、邮箱：
本目录推荐新书
··········
本目录推荐阅读
Copyright (C) 读书网
, All Rights Reserved.鄂ICP备号 公安备扫扫二维码，随身浏览文档
手机或平板扫扫即可继续访问
CAD面域.doc
举报该文档为侵权文档。
举报该文档含有违规或不良信息。
反馈该文档无法正常浏览。
举报该文档为重复文档。
推荐理由：
将文档分享至：
分享完整地址
文档地址：
粘贴到BBS或博客
flash地址：
支持嵌入FLASH地址的网站使用
html代码：
&embed src='/DocinViewer-4.swf' width='100%' height='600' type=application/x-shockwave-flash ALLOWFULLSCREEN='true' ALLOWSCRIPTACCESS='always'&&/embed&
450px*300px480px*400px650px*490px
支持嵌入HTML代码的网站使用
您的内容已经提交成功
您所提交的内容需要审核后才能发布，请您等待！
3秒自动关闭窗口