绘制垂直线
大家好，我是新手，如果你觉得这很烦人，请原谅我的愚蠢。
这就是问题所在。我目前正在为佛兰德政府制作地图。在你看来，有些事情会一次又一次地返回，所以我想让整个过程加快一点。
我必须在现有的线上画两条垂直的线，就像这样：
_____-->l _____l
当我从左向右单击点时：
______
| |
反过来说。
线路长度恒定，为0.3m
到目前为止，我有以下内容，但由于不同的数组类型，它不起作用，我想使用“GetPoint”过程。
Dim p0 as AcadPoint
Dim p1 as AcadPoint
Dim p2(1) as double
Dim p3(1) as Double
'The following only seems to work when I Dim p0 and p1 as variant
Set p0 = ThisDrawing.Utility.GetPoint()
Set p1 = ThisDrawing.Utility.GetPoint()
'Calculate the first point
p2(0) = p0(0) - 0.3 * (p0(1) - p1(1))/((p0(0)-p1(0))^2+(p0(1)-p1(1))^2)^0.5
'And so on for the other coördinates
'Then draw the lines
Dim pLine1 as AcadPolyLine
Set pLine1 = Thisdrawing.Application.ActiveDocument.Modelspade.Addline(p0, p2)
'Dito for the second line
编程，已经有一段时间了，所以如果你连这件简单的事情都做不到，那真是令人沮丧。
谢谢你的帮助！
阿诺特 我想你是想得到这样的东西：
Sub TestDrawLines()
Dim p0 As Variant
Dim p1 As Variant
Dim p2(2) As Double
Dim p3(2) As Double
On Error GoTo ErrorTrapping
'The following only seems to work when I Dim p0 and p1 as variant
p0 = ThisDrawing.Utility.GetPoint()
p1 = ThisDrawing.Utility.GetPoint(p0)
'Calculate the first point
p2(0) = p0(0) - 0.3 * (p0(1) - p1(1)) / ((p0(0) - p1(0)) ^ 2 + (p0(1) - p1(1)) ^ 2) ^ 0.5
'And so on for the other coordinates
'Then draw the lines
Dim Line1 As AcadLine
Set Line1 = ThisDrawing.ModelSpace.AddLine(p0, p2)
'Dito for the second line
Exit Sub
ErrorTrapping:
MsgBox "Program ends due to error!"
End Sub
嗨Joro
似乎就是这样！谢谢希望我的计算正确
谢谢 对于多输入，也可以尝试此代码
Option Explicit
'' ---> request check "Break on Unhandled Errors" inTools-> Options -> General tab<---
Public Sub DrawTicks()
Dim stPt As Variant, endPt As Variant
Dim intOsm As Integer
intOsm = ThisDrawing.GetVariable("OSMODE")
ThisDrawing.SetVariable "OSMODE", 0
Dim Pi As Double
Pi = Atn(1#) * 4
Do
On Error Resume Next
stPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "First point (ENTER or Right click to exit): ")
If Err Then
Err.Clear
Exit Do
End If
On Error GoTo 0
endPt = ThisDrawing.Utility.GetPoint(stPt, vbCrLf & "End point: ")
If Err Then
Err.Clear
Exit Do
End If
On Error GoTo 0
Dim ang As Double
ang = ThisDrawing.Utility.AngleFromXAxis(stPt, endPt)
Dim tmp As Variant
tmp = ThisDrawing.Utility.PolarPoint(stPt, ang + Pi / 2, 0.3)
Dim oLine As AcadLine
Set oLine = ThisDrawing.ModelSpace.AddLine(stPt, endPt)
Set oLine = ThisDrawing.ModelSpace.AddLine(stPt, tmp)
tmp = ThisDrawing.Utility.PolarPoint(endPt, ang + Pi / 2, 0.3)
Set oLine = ThisDrawing.ModelSpace.AddLine(endPt, tmp)
Loop
On Error GoTo 0
ThisDrawing.SetVariable "OSMODE", intOsm
End Sub
谢谢你的帮助！ 开始新事物的时间：
http://docs.autodesk.com/ACD/2010/ENU/AutoCAD%20.NET%20Developer's%20指南/索引。html？url=WS1a9193826455f5ff2566ffd511ff6f8c7ca-4875。htm，主题编号=d0e51
在我看来
干杯 Just a dumb question why not use a line type ? All linetypes are created with known dimensions and when used at correct scale reflect the true dimension.
This a 9m spacing with 3m gap
*LANE1000,____ _____ ____
A,3.00,-9.00 Here is two procedures you sked for
try again
Option Explicit'' request check "Break on Unhandled Errors" in General options' 1. draw lines by picking pointsPublic Sub DrawTicks()Dim stPt As Variant, endPt As VariantDim intOsm As IntegerintOsm = ThisDrawing.GetVariable("OSMODE")ThisDrawing.SetVariable "OSMODE", 0Dim PI As DoublePI = Atn(1#) * 4'create layer if this does not existsIf Not LayerExists("N_WLI2") Then AddLayer ("N_WLI2")DoOn Error Resume NextstPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "First point (ENTER or Right click to exit): ")If Err ThenErr.ClearExit DoEnd IfOn Error GoTo 0endPt = ThisDrawing.Utility.GetPoint(stPt, vbCrLf & "End point: ")If Err ThenErr.ClearExit DoEnd IfOn Error GoTo 0Dim ang As Doubleang = ThisDrawing.Utility.AngleFromXAxis(stPt, endPt)Dim tmp As Varianttmp = ThisDrawing.Utility.PolarPoint(stPt, ang + PI / 2, 0.3)Dim oLine As AcadLineSet oLine = ThisDrawing.ModelSpace.AddLine(stPt, endPt)Set oLine = ThisDrawing.ModelSpace.AddLine(stPt, tmp)tmp = ThisDrawing.Utility.PolarPoint(endPt, ang + PI / 2, 0.3)Set oLine = ThisDrawing.ModelSpace.AddLine(endPt, tmp)LoopOn Error GoTo 0ThisDrawing.SetVariable "OSMODE", intOsmEnd Sub'2.0 for existing linesPublic Sub AddTicks()Dim sset As AcadSelectionSetDim dxfCode, dxfValueDim ftype(1) As IntegerDim fdata(1) As Variantftype(0) = 0: fdata(0) = "LINE"ftype(1) = 8: fdata(1) = "N_WLI2" ' Hi guys,
Right, i've had a bit of sleep and got on it straight away. The following is the end-product, and works just fine!
Sub Kop3() Dim p0 As Variant Dim p1 As Variant Dim p2(2) As Double Dim p3(2) As Double Dim pLine1, pLine2 As AcadLine On Error GoTo ErrorTrapping p0 = ThisDrawing.Utility.GetPoint(, "Eerste punt (ENTER of Rechtse klik om te verlaten):") p1 = ThisDrawing.Utility.GetPoint(p0, "Eindpunt (ENTER of Rechtse klik om te verlaten):") p2(0) = p0(0) - (0.3 * (p0(1) - p1(1)) / ((p0(0) - p1(0)) ^ 2 + (p0(1) - p1(1)) ^ 2) ^ 0.5) p2(1) = p0(1) + (0.3 * (p0(0) - p1(0)) / ((p0(0) - p1(0)) ^ 2 + (p0(1) - p1(1)) ^ 2) ^ 0.5) p3(0) = p1(0) - (0.3 * (p0(1) - p1(1)) / ((p0(0) - p1(0)) ^ 2 + (p0(1) - p1(1)) ^ 2) ^ 0.5) p3(1) = p1(1) + (0.3 * (p0(0) - p1(0)) / ((p0(0) - p1(0)) ^ 2 + (p0(1) - p1(1)) ^ 2) ^ 0.5) Set pLine1 = ThisDrawing.Application.ActiveDocument.ModelSpace.AddLine(p0, p2) Set pLine2 = ThisDrawing.Application.ActiveDocument.ModelSpace.AddLine(p1, p3) Dim Layer As AcadLayer Set Layer = ThisDrawing.Application.ActiveDocument.Layers.Add("N_WLI2") pLine1.Layer = "N_WLI2" pLine2.Layer = "N_WLI2" Exit Sub ErrorTrapping: MsgBox "Fout bij het aanduiden!"End Sub
Thanks for the help! Time to start new stuffs:
http://docs.autodesk.com/ACD/2010/ENU/AutoCAD%20.NET%20Developer's%20Guide/index.html?url=WS1a9193826455f5ff2566ffd511ff6f8c7ca-4875.htm,topicNumber=d0e51
In my opinion
Cheers
页:
[1]