获取CAD中线的每个节点坐标程序设计.docx
《获取CAD中线的每个节点坐标程序设计.docx》由会员分享，可在线阅读，更多相关《获取CAD中线的每个节点坐标程序设计.docx（22页珍藏版）》请在冰豆网上搜索。
获取CAD中线的每个节点坐标程序设计
获取CAD中线的每个节点坐标程序设计
（一）
获取CAD中线的每个节点坐标，线包括polyline、3Dpolyline、Spline等等！
程序代码如下：
ImportsSystem
ImportsSystem.IO
ImportsSystem.Math
PublicClass获取CAD中点坐标
PublicAcadAppAsAutoCAD.AcadApplication
Publicxx（）,yy（）,zz（）AsDouble
PublicCountAsInteger
PublicreturnObjAsObject
PublicFolderPathAsString="C:
/"
PublicStepNumAsInteger=0
PrivateDeclareAutoFunctionSetProcessWorkingSetSizeLib"kernel32.dll"（ByValprocHandleAsIntPtr,ByValminAsInt32,ByValmaxAsInt32）AsBoolean
PublicSubSetProcessWorkingSetSize（） '节约系统内存
Try
DimMemAsProcess
Mem=Process.GetCurrentProcess（）
SetProcessWorkingSetSize（Mem.Handle,-1,-1）
CatchexAsException
MsgBox（ex.ToString）
EndTry
EndSub
PublicSub启动CAD（）
OnErrorResumeNext
AcadApp=GetObject（,"AutoCAD.Application"）
IfErr.NumberThen
Err.Clear（）
AcadApp=CreateObject（"AutoCAD.Application"）
EndIf
AcadApp.Visible=True
AcadApp.WindowState=AutoCAD.AcWindowState.acMax
AppActivate（AcadApp.Caption）
EndSub
PublicSub获取样条线节点坐标（）
DimiAsInteger
Fori=0To10000StepStepNum
OnErrorGoTohandle01
Count=i
ReDimPreservexx（i）
ReDimPreserveyy（i）
ReDimPreservezz（i）
xx（i）=returnObj.Coordinate（i）（0）
yy（i）=returnObj.Coordinate（i）
（1）
zz（i）=returnObj.elevation
Next
handle01:
Count=Count-1
EndSub
PublicSub获取Spline线节点坐标（）
DimfitPointsAsObject
DimiAsInteger
Fori=0ToreturnObj.NumberOfControlPoints-1StepStepNum
fitPoints=returnObj.GetControlPoint（i）
Count=i
ReDimPreservexx（i）
ReDimPreserveyy（i）
ReDimPreservezz（i）
xx（i）=fitPoints（0）
yy（i）=fitPoints
（1）
zz（i）=fitPoints
（2）
Next
EndSub
PublicSub获取Spline线拟合点坐标（）
DimfitPointsAsObject
DimppAsAutoCAD.AcadSpline
DimiAsInteger
Fori=0ToreturnObj.NumberOfFitPoints-1StepStepNum
fitPoints=returnObj.GetFitPoint（i）
Count=i
ReDimPreservexx（i）
ReDimPreserveyy（i）
ReDimPreservezz（i）
xx（i）=fitPoints（0）
yy（i）=fitPoints
（1）
zz（i）=fitPoints
（2）
Next
EndSub
PublicSub获取line线节点坐标（）
DimStartPointsAsObject
DimEndPointsAsObject
ReDimPreservexx
（1）
ReDimPreserveyy
（1）
ReDimPreservezz
（1）
Count=1
returnObj.highlight（True）
StartPoints=returnObj.StartPoint
EndPoints=returnObj.EndPoint
xx（0）=StartPoints（0）
yy（0）=StartPoints
（1）
zz（0）=StartPoints
（2）
xx
（1）=EndPoints（0）
yy
（1）=EndPoints
（1）
zz
（1）=EndPoints
（2）
EndSub
PublicSub获取2DPolyline节点坐标（）
'DimsssAsAutoCAD.AcadLWPolyline
returnObj.highlight（True）
DimiAsInteger
Fori=0To10000StepStepNum
OnErrorGoTohandle01
Count=i
ReDimPreservexx（i）
ReDimPreserveyy（i）
ReDimPreservezz（i）
xx（i）=returnObj.Coordinate（i）（0）
yy（i）=returnObj.Coordinate（i）
（1）
zz（i）=returnObj.elevation
Next
handle01:
Count=Count-1
EndSub
PrivateSubButton1_Click（ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs）HandlesButton1.Click
OnErrorGoTohandle01
Call启动CAD（）
DimbasePntAsObject
AcadApp.ActiveDocument.Utility.GetEntity（returnObj,basePnt）
returnObj.highlight（True）
'判断线的类型
DimLineTypenNameAsString
LineTypenName=returnObj.ObjectName.ToString（）
IfLineTypenName="AcDbLine"Then
Call获取line线节点坐标（）
ElseIfLineTypenName="AcDbSpline"Then
Call获取Spline线节点坐标（）
ElseIfLineTypenName="AcDbPolyline"Then
Call获取样条线节点坐标（）
Else:
ExitSub
EndIf
IfTextBox1.Text<>0OrTextBox2.Text<>0OrTextBox4.Text<>0Then
CallCalculateCoordinate（）
EndIf
DimiAsInteger
DimsAsString=""
Fori=0ToCount
s=s+xx（i）.ToString（）+","+yy（i）.ToString（）+","+zz（i）.ToString（）+Chr（13）
Next
RichTextBox1.Text=s
Button3.Enabled=True
AppActivate（Me.Text）
ExitSub
handle01:
MsgBox（Err.Description）
EndSub
PrivateSubButton2_Click（ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs）HandlesButton2.Click
OnErrorGoTohandle01
DimdgAsNewOpenFileDialog
dg.Filter="CADfiles（*.dwg）|*.dwg|Allfiles（*.*）|*.*"
dg.ShowDialog（）
DimsAsString=dg.FileName
Ifs=""ThenExitSub
启动CAD（）
AcadApp.Application.Documents.Open（s）
AcadApp.ActiveDocument.WindowState=AutoCAD.AcWindowState.acMax
AppActivate（Me.Text）
Button1.Enabled=True
ExitSub
handle01:
MsgBox（Err.Description）
EndSub
PrivateSubButton3_Click（ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs）HandlesButton3.Click
OnErrorGoTohandle01
DimdgAsNewSaveFileDialog
dg.Filter="txtfiles（*.txt）|*.txt|datfiles（*.dat）|*.dat"
dg.ShowDialog（）
DimsAsString=dg.FileName
DimiAsInteger
Dims1AsString=""
UsingswAsStreamWriter=NewStreamWriter（s）
Fori=0ToCount
s1=xx（i）.ToString（）+","+yy（i）.ToString（）+","+zz（i）.ToString（）
sw.WriteLine（s1）
Next
sw.Close（）
EndUsing
ExitSub
handle01:
MsgBox（Err.Description）
EndSub
PrivateSubButton4_Click（ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs）HandlesButton4.Click
AcadApp.ActiveDocument.Regen（AutoCAD.AcRegenType.acActiveViewport）
EndSub
PublicSubCalculateCoordinate（）
OnErrorGoTohandle01
Dimx0,y0,RotangleAsDouble
x0=TextBox1.Text
y0=TextBox2.Text
Rotangle=（TextBox4.Text）*3.1415926/180
DimiAsInteger
Dimx1,y1AsDouble
IfCos（Rotangle）=0Then
Fori=0ToCount
x1=xx（i）
xx（i）=yy（i）-y0
yy（i）=x0-x1
Next
ExitSub
EndIf
Fori=0ToCount
y1=（yy（i）-y0-（xx（i）-x0）*Tan（Rotangle））*Cos（Rotangle）
x1=（xx（i）-x0）/Cos（Rotangle）+y1*Tan（Rotangle）
IfAbs（x1）<0.00001Thenx1=0'设置精度
IfAbs（y1）<0.00001Theny1=0
xx（i）=x1
yy（i）=y1
Next
ExitSub
handle01:
MsgBox（Err.Description）
EndSub
PrivateSubTextBox2_TextChanged（ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs）HandlesTextBox2.TextChanged
EndSub
PrivateSub批量获取节点坐标Button_Click（ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs）Handles批量获取节点坐标Button.Click
StaticExitNumAsInteger
OnErrorGoTohandle01
StaticSaveNumAsInteger
Call启动CAD（）
DimbasePntAsObject
AcadApp.ActiveDocument.Utility.GetEntity（returnObj,basePnt）
returnObj.highlight（True）
AcadApp.ActiveDocument.SendCommand（"@选取下一条线!
连续在空白地方点击两次将会自动退出批量存储状态!
"+vbCr）
'判断线的类型
DimLineTypenNameAsString
LineTypenName=returnObj.ObjectName.ToString（）
IfLineTypenName="AcDbLine"Then
Call获取line线节点坐标（）
ElseIfLineTypenName="AcDbSpline"Then
Call获取Spline线节点坐标（）
ElseIfLineTypenName="AcDbPolyline"Then
Call获取样条线节点坐标（）
EndIf
IfTextBox1.Text<>0OrTextBox2.Text<>0OrTextBox4.Text<>0Then
CallCalculateCoordinate（）
EndIf
DimjAsInteger
Dims1AsString=""
UsingswAsStreamWriter=NewStreamWriter（FolderPath+SaveNum.ToString（）+".txt"）
Forj=0ToCount
s1=xx（j）.ToString（）+","+yy（j）.ToString（）+","+zz（j）.ToString（）
sw.WriteLine（s1）
Next
sw.Close（）
SaveNum=SaveNum+1
EndUsing
ExitNum=0
Call批量获取节点坐标Button_Click（sender,e）
ExitSub
handle01:
ExitNum=ExitNum+1
IfExitNum=2Then
ExitNum=0
ExitSub
Else:
Call批量获取节点坐标Button_Click（sender,e）
EndIf
EndSub
PrivateSub设置文件保存路径Button5_Click（ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs）Handles设置文件保存路径Button5.Click
DimfdgAsFolderBrowserDialog
fdg=NewFolderBrowserDialog
fdg.ShowDialog（）
Iffdg.SelectedPath=""ThenExitSub
FolderPath=fdg.SelectedPath
EndSub
PrivateSubButton5_Click（ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs）HandlesButton5.Click
OnErrorGoToHandle01
Call启动CAD（）
DimssetAsAutoCAD.AcadSelectionSet
sset=AcadApp.ActiveDocument.SelectionSets.Add（"NewSelectionSet"）
'提示用户选择对象
sset.SelectOnScreen（）
DimentAsObject
DimsssAsAutoCAD.AcadPoint
Count=-1
ForEachentInsset
升级会员 