Fatty
Joined: 08 Jun 2006
Posts: 8
Location: Sankt-Petersburg, Russia
|
 Posted:
Fri Jun 09, 2006 7:00 am Post subject:
Re: Bump |
|
|
| Zibnaf wrote: | | I am also looking for a way to create a scaleable crosshair in autoCAD. |
Change by your needs
| Code: |
Option Explicit
Sub CrossHair()
Dim oLine As AcadLine
Dim pc
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim p3(0 To 2) As Double
Dim p4(0 To 2) As Double
Dim lg, stp, lt, ang As Double
Const Pi As Double = 3.14159265359
ang = Pi / 2
On Error GoTo 0
pc = ThisDrawing.Utility.GetPoint(, "Pick center point")
lg = CDbl(InputBox("Enter crosshair length:", "Crosshair Length", 96))
stp = CDbl(InputBox("Enter step:", "Step", 8))
lt = CDbl(InputBox("Enter tick size:", "Tick Size", 3))
p1(0) = pc(0) - lt / 2: p1(1) = pc(1) - lg / 2: p1(2) = pc(2)
p2(0) = pc(0) + lt / 2: p2(1) = pc(1) - lg / 2: p2(2) = pc(2)
Set oLine = ThisDrawing.ModelSpace.AddLine(p1, p2)
Dim arrObj As Variant
arrObj = oLine.ArrayRectangular((lg \ stp) + 1, 1, 1, stp, 0, 0)
Dim icnt As Integer
icnt = (UBound(arrObj) - 1) \ 2
Dim lineObj As Object
Set lineObj = arrObj(icnt)
p3(0) = pc(0) - lg / 2: p3(1) = pc(1): p3(2) = pc(2)
p4(0) = pc(0) + lg / 2: p4(1) = pc(1): p4(2) = pc(2)
lineObj.StartPoint = p3
lineObj.EndPoint = p4
lineObj.color = acRed
lineObj.Update
Dim copyObj As Object
For icnt = 0 To UBound(arrObj)
Set copyObj = arrObj(icnt).Copy
copyObj.Rotate pc, ang
Next icnt
Dim copyLine As Object
Set copyLine = oLine.Copy
copyLine.Rotate pc, ang
ZoomExtents
End Sub
|
|
|
FAQ
Memberlist
Register
Profile
Log in to check your private messages
Log in
