开发工具:
文件大小: 3kb
下载次数: 0
上传时间: 2010-12-01
详细说明： '统计字符串中是否有文字，是否全是数字 Function hasnoChinese(str) bl = True For i = 1 to Len(str) - 0 'ss=CStr(Asc(Mid(str,i,1))) 'msgbox ss If Asc(Mid(str,i,1)) < 0 Then bl = False End If Next hasnoChinese = bl End Function Function UnAdjustNote(FontClass,dx,dy,widscale,heightscale,nochinese) SSProcess.ClearSelection SSProcess.ClearSelectCondition SSProcess.SetSelectCondition "SSObj_Type", "=", "NOTE" SSProcess.SetSelectCondition "SSObj_FontClass", "=", FontClass SSProcess.S etSelectCondition "[DGNAttr_FontID]", "<>", "188" SSProcess.SelectFilter SSProcess.PushUndoMark notecount = SSProcess.GetSelNoteCount 'msgbox notecount For i=0 To notecount-1 txtx=SSProcess.GetSelNoteValue( i, "SSObj_FontString") If hasnoChinese(txtx) = nochinese Then pointcount = SSProcess.GetSelNotePointCount(i) For j=0 To pointcount-1 Dim x, y, z, pointtype, name SSProcess.GetSelNotePoint i, j, x, y, z, pointtype, name x = x - dx y = y - dy SSProcess.SetSelNotePoint i, j, x, y, z, pointtype, name Next wid=SSProcess.GetSelNoteValue( i, "SSObj_FontWidth") hit=SSProcess.GetSelNoteValue( i, "SSObj_FontHeight") wid1=CStr(CDbl(wid) / widscale) hit1=CStr(CDbl(hit) / heightscale) SSProcess.SetSelNoteValue i, "SSObj_FontWidth", wid1 SSProcess.SetSelNoteValue i, "SSObj_FontHeight", hit1 SSProcess.AddSelNoteToSaveNoteList i End If Next End Function Function changeNoteDw() UnAdjustNote "#",0,0,1.16,1,True UnAdjustNote "#",0,0,1.16,1,False UnAdjustNote "FZ",0,0,1.25,1,True UnAdjustNote "FZ",0,0,1.25,1,False UnAdjustNote "@",0,0,1.275,1,True UnAdjustNote "@",0,0,1.275,1,False UnAdjustNote "899000",0,0,1.27,1,True UnAdjustNote "899000",0,0,1.27,1,False UnAdjustNote "DXLC",0,0,1.333,1,True UnAdjustNote "DXLC",0,0,1.333,1,False UnAdjustNote "499000",-0.117,0,1,1.3,True UnAdjustNote "499000",-0.117,0,1,1.3,False End Function Function UnAdjustNote1(EpsFontClass,dx,dy,widscale,heightscale,nochinese) SSProcess.ClearSelection SSProcess.ClearSelectCondition SSProcess.SetSelectCondition "SSObj_Type", "=", "NOTE" SSProcess.SetSelectCondition "SSObj_FontClass", "=", EpsFontClass SSProcess.SelectFilter SSProcess.PushUndoMark notecount = SSProcess.GetSelNoteCount 'msgbox notecount For i=0 To notecount-1 txtx=SSProcess.GetSelNoteValue( i, "SSObj_FontString") If hasnoChinese(txtx) = nochinese Then pointcount = SSProcess.GetSelNotePointCount(i) For j=0 To pointcount-1 Dim x, y, z, pointtype, name SSProcess.GetSelNotePoint i, j, x, y, z, pointtype, name x = x - dx y = y - dy SSProcess.SetSelNotePoint i, j, x, y, z, pointtype, name Next wid=SSProcess.GetSelNoteValue( i, "SSObj_FontWidth") hit=SSProcess.GetSelNoteValue( i, "SSObj_FontHeight") wid1=CStr(CDbl(wid) / widscale) hit1=CStr(CDbl(hit) / heightscale) SSProcess.SetSelNoteValue i, "SSObj_FontWidth", wid1 SSProcess.SetSelNoteValue i, "SSObj_FontHeight", hit1 SSProcess.AddSelNoteToSaveNoteList i End If Next End Function Function changeNoteDw1() '属于86号字体(居民地注记) UnAdjustNote1 "297000",2.5,0,1.33,1.25,True UnAdjustNote1 "297000",2.5,0,1.33,1.25,False UnAdjustNote1 "297100",1.25,-0.3,1.33,1.25,True UnAdjustNote1 "297100",1.25,-0.3,1.33,1.25,False UnAdjustNote1 "297200",2.25,-0.3,1.33,1.25,True UnAdjustNote1 "297200",2.25,-0.3,1.33,1.25,False UnAdjustNote1 "297500",1.8,0,1.33,1.33,True UnAdjustNote1 "297500",1.8,0,1.33,1.33,False '属于86号字体(地貌注记) UnAdjustNote1 "881000",0.7,-0.15,1.3,1.25,True UnAdjustNote1 "881000",0.7,-0.15,1.3,1.25,False UnAdjustNote1 "882000",0.7,-0.15,1.3,1.33,True UnAdjustNote1 "882000",0.7,-0.15,1.3,1.33,False '属于242号字体(居民地注记) UnAdjustNote1 "297300",1.6,0,1.3,1.3,True UnAdjustNote1 "297300",1.6,0,1.3,1.3,False UnAdjustNote1 "297400",2,0,1.3,1.3,True UnAdjustNote1 "297400",2,0,1.3,1.3,False '属于86号字体(水系注记) 'UnAdjustNote "698100",0.3,0.25,1.25,1.4,True 'UnAdjustNote "698100",0.3,0.25,1.25,1.4,False UnAdjustNote1 "698100",-0.2,0,1.27,1.25,True UnAdjustNote1 "698100",-0.2,0,1.27,1.25,False UnAdjustNote1 "698200",-0.1,0.1,1.27,1.26,True UnAdjustNote1 "698200",-0.1,0.1,1.27,1.26,False UnAdjustNote1 "698300",-0.1,0.1,1.27,1.26,True UnAdjustNote "698300",-0.1,0.1,1.27,1.26,False '属于43号字体(居民地注记) UnAdjustNote1 "298000",0,-0.1,1.2,1.3,True UnAdjustNote1 "298000",0,-0.1,1.2,1.3,False UnAdjustNote1 "298200",0,-0.1,1.23,1.3,True UnAdjustNote1 "298200",0,-0.1,1.23,1.3,False '属于43号字体(交通注记注记) UnAdjustNote1 "498000",0.3,0,1.35,1.5,True UnAdjustNote1 "498000",0.3,0,1.35,1.5,False UnAdjustNote1 "498100",0.5,0,1.35,1.5,True UnAdjustNote1 "498100",0.5,0,1.35,1.5,False '属于88号字体(交通注记) UnAdjustNote1 "498200",1.3,-0.15,1.33,1.35,True UnAdjustNote1 "498200",1.3,-0.15,1.33,1.35,False UnAdjustNote1 "498300",1.3,-0.15,1.33,1.35,True UnAdjustNote1 "498300",1.3,-0.15,1.33,1.35,False UnAdjustNote1 "498400",1,-0.15,1.33,1.35,True UnAdjustNote1 "498400",1,-0.15,1.33,1.35,False End Function Function AddNewPointFormLine(Code,NewCode,distx,disty) SSProcess.ClearSelection SSProcess.ClearSelectCondition SSProcess.SetSelectCondition "SSObj_Type", "=", "LINE" SSProcess.SetSelectCondition "SSObj_Code", "=", Code SSProcess.SelectFilter geocount = SSProcess.GetSelGeoCount For i = 0 To geocount - 1 sso= SSProcess.GetSelGeoPointCount(i) If sso = 5 or sso = 4 Then '取出处理对象 ppid = SSProcess.GetSelGeoValue( i, "SSObj_ID") ppcode = SSProcess.GetSelGeoValue( i, "SSObj_Code") '取出对象点坐标 x0 = CDbl(SSProcess.GetObjectAttr( ppid, "SSObj_X(0)")) y0 = CDbl(SSProcess.GetObjectAttr( ppid, "SSObj_Y(0)")) x1 = CDbl(SSProcess.GetObjectAttr( ppid, "SSObj_X(1)")) Y1 = CDbl(SSProcess.GetObjectAttr( ppid, "SSObj_Y(1)")) x3 = CDbl(SSProcess.GetObjectAttr( ppid, "SSObj_X(3)")) y3 = CDbl(SSProcess.GetObjectAttr( ppid, "SSObj_Y(3)")) '算出准备插入点符号的位置x,y If ppcode <> 515100 Then x = (x0 + x3)/2 y = (y0 + y3)/2 '距离 dist1 = sqr((x0-x3)*(x0-x3)+(y0-y3)*(y0-y3)) dist2 = sqr((x0-x1)*(x0-x1)+(y0-y1)*(y0-y1)) scalex = dist1/distx scaley = dist2/disty '角度 Dx = x1-x0 Dy = y1-y0 If Dx = 0 and Dy > 0 Then arc = 0 ElseIf Dx = 0 and Dy < 0 Then arc = 3.1415926 ElseIf Dx < 0 and Dy < 0 Then arc = 3.1415926-atn(Dx/Dy) ElseIf Dx < 0 and Dy = 0 Then arc = 3.1415926/2 ElseIf Dx > 0 and Dy = 0 Then arc = -3.1415926/2 ElseIf Dx > 0 and Dy < 0 Then arc = 3*3.1415926-atn(Dx/Dy) Else arc = 2*3.1415926-atn(Dx/Dy) End If Else x = (x1 + x3)/2 y = (y1 + y3)/2 '距离 dist1 = sqr((x0-x3)*(x0-x3)+(y0-y3)*(y0-y3)) dist2 = sqr((x0-x1)*(x0-x1)+(y0-y1)*(y0-y1)) scalex = dist1/distx scaley = dist2/disty '角度 Dx = x1-x0 Dy = y1-y0 If Dx = 0 and Dy > 0 Then arc = 0 ElseIf Dx = 0 and Dy < 0 Then arc = 3.1415926 ElseIf Dx < 0 and Dy < 0 Then arc = 3.1415926-atn(Dx/Dy) ElseIf Dx < 0 and Dy = 0 Then arc = 3.1415926/2 ElseIf Dx > 0 and Dy = 0 Then arc = -3.1415926/2 ElseIf Dx > 0 and Dy < 0 Then arc = 3*3.1415926-atn(Dx/Dy) Else arc = 2*3.1415926-atn(Dx/Dy) End If End If '按照x，y，scale插入点符号 SSProcess.CreateNewObj 0 SSProcess.SetNewObjValue "SSObj_Code", NewCode SSProcess.SetNewObjValue "SSObj_LineType", "0" SSProcess.SetNewObjValue "SSObj_LayerName", "DEFAULT" SSProcess.SetNewObjValue "SSObj_Color", "RGB(255,255,0)" SSProcess.SetNewObjValue "SSObj_Angle", arc SSProcess.SetNewObjValue "SSObj_ScaleX", scalex SSProcess.SetNewObjValue "SSObj_ScaleY", scaley SSProcess.AddNewObjPoint x, y, 0, 0, "" SSProcess.AddNewObjToSaveObjList End If Next End Function Function lineTopoint() AddNewPointFormLine "221100","2211001","1","0.75" AddNewPointFormLine "861100","8611001","1","0.5" AddNewPointFormLine "515100","5151001","0.5","0.5" End Function Function arcTodgn() SSProcess.ClearSelection SSProcess.ClearSelectCondition SSProcess.SetSelectCondition "SSObj_Type", "==", "LINE" SSProcess.SetSelectCondition "SSObj_LineType", "==", "4" SSProcess.SetSelectCondition "", "==", "1" SSProcess.SelectFilter geoCount = SSProcess.GetSelGeoCount For i=0 To geoCount-1 geoID = CLng(SSProcess.GetSelGeoValue (i, "SSObj_ID")) SSProcess.ObjectDeal geoID, "GotoPoints", "", result Next End Function Function ExportDgn( fileName ) SSProcess.SetMapStatus 1,2 '输出DGN前的锁库处理 changeNoteDw changeNoteDw1 lineTopoint arcTodgn '工作台面目录下的DGN种子文件 dgnSeedFile = SSProcess.GetSysPathName (8) & "seed5h.dgn" '工作台面目录下的线型对照文件 dgnlinestylefile = SSProcess.GetSysPathName (8) & "dgnlinestyle.lin" '清空转换参数 SSProcess.ClearDataXParameter '设置输出文件格式为DGN SSProcess.SetDataXParameter "DataType", "9" 'DGN种子文件 SSProcess.SetDataXParameter "EXCHANGE_DGN_SeedFile", dgnSeedFile 'DGN线型对照文件 SSProcess.SetDataXParameter "EXCHANGE_DGN_LineStyleFile", dgnlinestylefile '设置输出文件名 SSProcess.SetDataXParameter "ExportPathName", fileName '设置使用编码表 SSProcess.SetDataXParameter "FeatureCodeTBName", "FeatureCodeTB_OutDgn" SSProcess.SetDataXParameter "SymbolScriptTBName", "SymbolScriptTB_OutDgn" SSProcess.SetDataXParameter "NoteTemplateTBName", "NoteTemplateTB_OutDgn" SSProcess.SetDataXParameter "ExplodeObjLayerStatus","0" SSProcess.SetDataXParameter "DataBoundMode", "2" SSProcess.SetDataXParameter "LayerRelationCount", "1" SSProcess.SetDataXParameter "LayerRelation1", "图廓层:60:60:60:60:60" '打散对象编组输出 SSProcess.SetDataXParameter "ExplodeObjMakeGroup", "1" '颜色使用编码表指定 SSProcess.SetDataXParameter "ColorUseStatus", "0" '图层使用编码表指定 SSProcess.SetDataXParameter "LayerUseStatus", "0" '面地物输出方式 0 Shape 1 LineString SSProcess.SetDataXParameter "EXCHANGE_DGN_ExportAreaMode", "1" '线串最多点数 SSProcess.SetDataXParameter "EXCHANGE_DGN_MaxLineStringPointCount", "101" '开始输出数据 SSProcess.ExportData SSProcess.SetMapStatus 0,2 SSProcess.MapMethod "Unloaddata","" SSProcess.MapMethod "loaddata", "" End Function Sub OnClick() pathName = SSProcess.SelectPathName( ) If pathName = "" Then Exit Sub End If SSProcess.CreateMapFrame frameCount = SSProcess.GetMapFrameCount() For i=0 To frameCount-1 SSProcess.GetMapFrameCenterPoint i, x, y SSProcess.SetCurMapFrame x, y, 0, "" frameID = SSProcess.GetCurMapFrame() mapNumber = SSProcess.GetObjectAttr( CLng(frameID), "[MapNumber]") If mapNumber <> "" Then fileName = pathName & mapNumber & ".DGN" ExportDgn fileName End If Next SSProcess.FreeMapFrame End Sub ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台，提供交流渠道，下载内容来自于网络，除下载问题外，其它问题请自行百度。
- 本站已设置防盗链，请勿用迅雷、QQ旋风等多线程下载软件下载资源，下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载，请稍后再次尝试；或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎，请到消费记录里找到下载记录反馈给我们，经确认后退回积分.
- 如下载前有疑问，可以通过点击"提供者"的名字，查看对方的联系方式，联系对方咨询.
