autocad二次开发vba代码汇总[地鼠版]___

《autocad二次开发vba代码汇总[地鼠版]___》由会员上传分享，免费在线阅读，更多相关内容在教育资源-天天文库。

1、AUTOCAD二次开发VBA代码汇总1精华代码汇总1.1保存数据PrivateSubCommandButton1_Click()OnErrorResumeNext'得到dvb工程路径DimdvbpathAsStringDimdvbpath_fAsStringDimMyIDEAsObjectDimProsAsObjectDimproAsObjectSetMyIDE=ThisDrawing.Application.VBESetPros=MyIDE.vbprojectsForEachproInProsIfRight$(pro.FileName,Len("断面采集绘制.dvb"))="断面采集绘制.d

2、vb"Thendvbpath=Left$(pro.FileName,(Len(pro.FileName)-Len("断面采集绘制.dvb")-1))EndIfNextproOpendvbpath&"数据保存.csv"ForOutputAs#1DimiAsIntegerFori=0To(ListBox1.ListCount-1)Print#1,ListBox1.List(i,0)&","&ListBox1.List(i,1)NextiClose#1MsgBox("数据已保存在["&dvbpath&"数据保存.csv]文件里")EndSub1.2插入块炸开并改变块文字的特定字符'******绘

3、制水池名称、水池底高程******'设置当前文本样式为"0数字字母小"ThisDrawing.ActiveTextStyle=ThisDrawing.TextStyles.Item("0数字字母小")DimblockrefobjAsAcadBlockReference'块相关变量Diminsertionpnt(0To2)AsDoubleinsertionpnt(0)=0#:insertionpnt(1)=(Val(qsgc)-Val(biao_ga_di))*1000*hxbl#:insertionpnt(2)=0#'插入"ls_取水池名称及高程"块Setblockrefobj=ThisDra

4、wing.ModelSpace.InsertBlock(insertionpnt,"ls_取水池名称及高程",1#,1#,1#,0)blockrefobj.Explodeblockrefobj.Delete'修改对应文字DimssetObjAsAcadSelectionSetDimFilterType(3)AsIntegerDimFilterData(3)AsVariantOnErrorResumeNextSetssetObj=ThisDrawing.SelectionSets.Add("SSET")IfErrThenErr.ClearSetssetObj=ThisDrawing.Select

5、ionSets.Item("SSET")EndIfssetObj.ClearFilterType(0)=-4'选择对象FilterData(0)=""ssetObj.SelectacSelectionSetAll,,,FilterType,FilterDataFori=0TossetObj.Count-1IfssetObj.Item(i).textstring="ls_取水池名称

6、"ThenssetObj.Item(i).textstring=Replace(ssetObj.Item(i).textstring,"ls_取水池名称",qsctxt)'替换特定字符为水池名称IfssetObj.Item(i).textstring="ls_qscgc"ThenssetObj.Item(i).textstring=qsgcNexti1.3窗体悬浮置顶PrivateSubCommandButton7_Click()IfCommandButton7.Caption="悬浮"ThenCommandButton7.Caption="置顶"UserForm1.HideUserForm1

7、.Show(0)ElseCommandButton7.Caption="悬浮"UserForm1.HideUserForm1.Show(1)EndIfEndSubPrivateSubUserForm_Initialize()UserForm1.Left=(ThisDrawing.Width-UserForm1.Width)/2UserForm1.top=(ThisDrawing.height-Us