liusong0517
发表于 2008-4-1 19:53:00
<p>非常不错哦</p>
kh0773
发表于 2008-4-2 12:28:00
<p>哪位大哥能告诉偶怎么用呀?</p><p> 是以什么格式保存啊?</p>
chtd
发表于 2008-4-8 20:24:00
<p>几个线等分的例子：</p><p>Dim mysel As AcadSelectionSet<br/>Dim lay As AcadLayer<br/>Dim zb3(0 To 2) As Double<br/>Dim zb2(0 To 2) As Double<br/>Dim zbb(0 To 5) As Double<br/>Dim zb As Variant<br/>Dim jl As Double<br/>Dim jl1 As Double<br/>Dim jl2 As Double<br/>Dim jl4 As Double<br/>Dim zb1(0 To 2) As Double<br/>Dim jd As Double<br/>If ThisDrawing.SelectionSets.count = 0 Then<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>Else<br/>ThisDrawing.SelectionSets.Item(0).Delete<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>End If<br/>Dim sz As Long<br/>Dim cd As Double<br/>On Error GoTo dd<br/>jl1 = ThisDrawing.Utility.GetString(0, "请输入离散点间距:")<br/>dd = ThisDrawing.Utility.GetString(0, "请输入等分线长度:")<br/>For Each selentity In mysel<br/> If selentity.EntityType = 2 Then<br/> <br/> zb = selentity.Coordinates<br/> jl = 0: sz = 2<br/> ReDim zuob(0 To sz) As Double<br/> For i = 0 To UBound(zb) - 3 Step 3<br/> 'ReDim Preserve zuob(0 To sz) As Double<br/> jl2 = Sqr((zb(i) - zb(i + 3)) ^ 2 + (zb(i + 1) - zb(i + 4)) ^ 2)<br/> jl = jl + jl2<br/> If jl > jl1 Then<br/> jl4 = jl2 - (jl - jl1)<br/> Do Until jl < jl1<br/> ReDim Preserve zuob(0 To sz) As Double<br/> zuob(sz - 2) = jl4 * (zb(i + 3) - zb(i)) / jl2 + zb(i)<br/> zuob(sz - 1) = jl4 * (zb(i + 4) - zb(i + 1)) / jl2 + zb(i + 1)<br/> zuob(sz) = jl4 * (zb(i + 5) - zb(i + 2)) / jl2 + zb(i + 2)<br/> zb2(0) = zb(i): zb2(1) = zb(i + 1): zb2(2) = zb(i + 2)<br/> zb3(0) = zb(i + 3): zb3(1) = zb(i + 4): zb3(2) = zb(i + 5)<br/> zb1(0) = zuob(sz - 2): zb1(1) = zuob(sz - 1): zb1(2) = zuob(sz)<br/> jd = ThisDrawing.Utility.AngleFromXAxis(zb2, zb3)<br/> jd = 3.1415926 / 2 - jd<br/> 'if jd<br/> cd = Val(dd) / 2<br/> zbb(0) = zb1(0) + cd * Cos(jd): zbb(1) = zb1(1) - cd * Sin(jd): zbb(2) = zb1(2)<br/> zbb(3) = zb1(0) - cd * Cos(jd): zbb(4) = zb1(1) + cd * Sin(jd): zbb(5) = zb1(2)<br/> ThisDrawing.ModelSpace.Add3DPoly zbb</p><p> sz = sz + 3<br/> jl = jl - jl1<br/> jl4 = jl4 + jl1<br/> Loop<br/> End If<br/> <br/> Next<br/> <br/> End If<br/>Next<br/>mysel.Delete<br/>dd:</p><p></p>
chtd
发表于 2008-4-8 20:25:00
<p>Dim mysel As AcadSelectionSet<br/>Dim lay As AcadLayer<br/>Dim zb(0 To 2) As Double</p><p>If ThisDrawing.SelectionSets.count = 0 Then<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>Else<br/>ThisDrawing.SelectionSets.Item(0).Delete<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>End If<br/>On Error GoTo dd<br/>cv = ThisDrawing.Utility.GetString(0, "请输入离散点间距:")<br/>If Val(cv) > 0 Then<br/>Set lay = ThisDrawing.Layers.Add("离散点")<br/>ThisDrawing.ActiveLayer = lay<br/>For Each selentity In mysel<br/>If selentity.EntityType = 2 Then<br/> zuob = selentity.Coordinates<br/> zb(0) = zuob(3): zb(1) = zuob(4): zb(2) = zuob(5)<br/> ThisDrawing.Application.ZoomCenter zb, 1<br/> ThisDrawing.SendCommand "_measure" & vbCr & zb(0) & "," & zb(1) & "," & zb(2) & vbCr & cv & vbCr<br/>selentity.Delete<br/>End If<br/>Next<br/>ThisDrawing.Application.ZoomExtents<br/>End If<br/>mysel.Delete<br/>dd:</p><p></p><p></p><p>Dim mysel As AcadSelectionSet<br/>Dim lay As AcadLayer<br/>Dim zb(0 To 2) As Double</p><p>If ThisDrawing.SelectionSets.count = 0 Then<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>Else<br/>ThisDrawing.SelectionSets.Item(0).Delete<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>End If<br/>On Error GoTo dd<br/>cv = ThisDrawing.Utility.GetString(0, "请输入离散点间距:")<br/>If Val(cv) > 0 Then<br/>Set lay = ThisDrawing.Layers.Add("离散点")<br/>ThisDrawing.ActiveLayer = lay<br/>For Each selentity In mysel<br/>If selentity.EntityType = 2 Then<br/> zuob = selentity.Coordinates<br/> zb(0) = zuob(3): zb(1) = zuob(4): zb(2) = zuob(5)<br/> ThisDrawing.Application.ZoomCenter zb, 1<br/> ThisDrawing.SendCommand "_divide" & vbCr & zb(0) & "," & zb(1) & "," & zb(2) & vbCr & cv & vbCr<br/>selentity.Delete<br/>End If<br/>Next<br/>ThisDrawing.Application.ZoomExtents<br/>End If<br/>mysel.Delete<br/>dd:</p>
AMTONNY
发表于 2008-4-30 20:32:00
找到大哥的感觉，----以后有人帮忙了
董堃
发表于 2008-4-30 20:48:00
<p>顶，虽然我不懂是什么代码</p>
yjc
发表于 2008-5-2 17:05:00
非常好，谢谢你了
chtd
发表于 2008-5-3 20:34:00
<p>批处理改高程值</p><p>Dim fpoint As Variant<br/>Dim tpoint(0 To 2) As Double<br/>If ThisDrawing.SelectionSets.count = 0 Then<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>Else<br/>ThisDrawing.SelectionSets.Item(0).Delete<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>End If</p><p>dd = ThisDrawing.Utility.GetString(0, "请输入要加的数值:")<br/>dd1 = ThisDrawing.Utility.GetString(0, "请输入要保留小数位数:")<br/>Dim dws As String<br/>dws = "#######."<br/>For i = 1 To dd1<br/> dws = dws + "0"<br/>Next<br/>For Each sel In mysel<br/> If sel.EntityType = 32 Or sel.EntityType = 21 Then<br/> sel.TextString = Format(Val(sel.TextString) + Val(dd), dws)<br/> ElseIf sel.EntityType = 7 Then<br/> fpoint = sel.InsertionPoint<br/> tpoint(0) = fpoint(0): tpoint(1) = fpoint(1)<br/> tpoint(2) = Val(Format(fpoint(2) + Val(dd), dws))<br/> sel.Move fpoint, tpoint<br/> ElseIf sel.EntityType = 22 Then<br/> fpoint = sel.Coordinates<br/> tpoint(0) = fpoint(0): tpoint(1) = fpoint(1)<br/> tpoint(2) = Val(Format(fpoint(2) + Val(dd), dws))<br/> sel.Move fpoint, tpoint<br/> End If<br/>Next</p><p>If mysel.count <> 0 Then<br/> mysel.Delete<br/>End If</p>
chtd
发表于 2008-5-3 20:39:00
<p>三维线注标高</p><p>Dim zuobiao As Variant<br/>Dim zuob As Variant<br/>Dim zuobb(0 To 2) As Double<br/>On Error GoTo we<br/>For i = 0 To 10000<br/>ThisDrawing.SetVariable "OSMODE", 512<br/>aat = ThisDrawing.Utility.GetInput()<br/>Dim mysel As AcadSelectionSet<br/>If ThisDrawing.SelectionSets.count = 0 Then<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>zuobiao = ThisDrawing.Utility.GetPoint(, "请选择:")<br/>mysel.SelectAtPoint zuobiao<br/>Else<br/>ThisDrawing.SelectionSets.Item(0).Delete<br/>AppActivate ThisDrawing.Application.Caption<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>zuobiao = ThisDrawing.Utility.GetPoint(, "请选择:")<br/>mysel.SelectAtPoint zuobiao<br/>End If<br/>ThisDrawing.SetVariable "OSMODE", 0<br/>If mysel.count = 1 Then<br/> If mysel(0).EntityType = 2 Then<br/> zuob = mysel(0).Coordinates<br/> zuobb(0) = zuobiao(0): zuobb(1) = zuobiao(1): zuobb(2) = zuob(2)<br/> retAngle = ThisDrawing.Utility.GetAngle(, "Enter an angle: ")<br/> Set zj2 = ThisDrawing.ModelSpace.addtext(Int(zuob(2)), zuobb, 3.75)<br/> zj2.Alignment = acAlignmentMiddle<br/> zj2.TextAlignmentPoint = zuobb<br/> zj2.ScaleFactor = 1<br/> zj2.Rotation = retAngle - 80<br/> zj2.Update<br/>End If<br/> End If<br/>If mysel.count <> 0 Then<br/> mysel.Delete<br/>End If<br/>Next<br/>we:<br/>ThisDrawing.SetVariable "OSMODE", 0</p>
chtd
发表于 2008-5-3 20:42:00
拿出一些程序原码与大家交流，希望与大家探讨，共同进步！