1、刚在网上翻到一段 VBA 代码据说是可以指量赋值，哪位大大看看能否把它转为 cad 的外挂程序，谢谢Private Sub CmdH_Click()接受输入步长值和增量Dim dblStart As Double, dblStep As DoubleDim dblStart0 As DoubleOn Error Resume NextdblStart = 0dblStep = 1dblStart = ThisDrawing.Utility.GetReal(vbCrLf + “请输入起始高程值(0): “)If Err.Number = -2145320928 Then Err.Cleardbl
2、Start0 = dblStartdblStep = ThisDrawing.Utility.GetReal(“请输入增量高程值(1): “)If Err.Number = -2145320928 Then Err.ClearDim index As Integerloop1:接受输入起止点dblStart = dblStart0On Error GoTo ExitLabelDim Pnt1 As Variant, Pnt2 As VariantPnt1 = ThisDrawing.Utility.GetPoint(, “请输入起点：“)Pnt2 = ThisDrawing.Utility.G
3、etPoint(Pnt1, “请输入终点：“)选择线段经过的多段线，构成选择集On Error Resume NextDim ssetObj As AcadSelectionSetSet ssetObj = ThisDrawing.SelectionSets(“CONTOUR_SSET“)If ssetObj Is Nothing ThenSet ssetObj = ThisDrawing.SelectionSets.Add(“CONTOUR_SSET“)Err.ClearEnd IfDim FilterType(0 To 4) As Integer, FilterData(0 To 4) A
4、s VariantFilterType(0) = -4FilterData(0) = “Dim PntList(0 To 5) As DoublePntList(0) = Pnt1(0): PntList(1) = Pnt1(1): PntList(2) = Pnt1(2)PntList(3) = Pnt2(0): PntList(4) = Pnt2(1): PntList(5) = Pnt2(2)ssetObj.ClearssetObj.SelectByPolygon acSelectionSetFence, PntList, FilterType, FilterData依次为选择集中每条多
5、段线设置高程Dim ent As ObjectDim NP As VariantDim i As IntegerFor Each ent In ssetObjSelect Case TypeName(ent)Case “IAcadLine“给直线的起止点赋高程NP = ent.StartPointNP(2) = dblStartent.StartPoint = NPNP = ent.EndPointNP(2) = dblStartent.EndPoint = NPCase “IAcadLWPolyline“给 LWPolyline 赋高程ent.Elevation = dblStartCase
6、 “IAcadPolyline“给 LWPolyline 赋高程ent.Elevation = dblStartCase Else给 3DPolyline 赋高程ReDim NPS(UBound(ent.Coordinates) As DoubleNPS = ent.CoordinatesFor i = 2 To UBound(ent.Coordinates) Step 3NPS(i) = dblStartNext ient.Coordinates = NPSEnd Selectent.color = acReddblStart = dblStart + dblStepNext输出执行结果汇报
7、If Err.Number = 0 ThenThisDrawing.Utility.Prompt “已成功的为等高线设置高程。 “ + vbCrLfElseThisDrawing.Utility.Prompt “执行过程中出现错误。 “ + vbCrLfEnd IfGoTo loop1ThisDrawing.SelectionSets(“CONTOUR_SSET“).DeleteExit SubExitLabel:MsgBox Err.DescriptionEnd SubPrivate Sub cmdHTd_Click()Dim 标高 As SingleDim sset As AcadSelectionSet 定义选择集对象Set sset = ThisDrawing.SelectionSets.Add(CStr(Timer) 新建一个选择集sset.SelectOnScreen 提示用户选择标高 = sset.Item(0).ElevationSet sset = ThisDrawing.SelectionSets.Add(CStr(Timer) 新建一个选择集sset.SelectOnScreen 提示用户选择sset.Item(0).TextString = CStr(标高)End Sub
