VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

how to create this block

0 REPLIES 0
Reply
Message 1 of 1
师兄
339 Views, 0 Replies

how to create this block

I want  create a blocka circle and a line in this block,then i insert this block into my document,

 

i need the normal of circle is pointing current  Z axis of ucs,the endpoint of line is pointing current X axis of ucs(any ucs), but my codes work is not my  effect, any one who see this message can help me?

 

Sub insblk()
With ThisDrawing
Dim ucs As AcadUCS
Dim org As Variant, xvec As Variant, yvec As Variant
org = .GetVariable("ucsorg")
xvec = .GetVariable("ucsxdir")
yvec = .GetVariable("ucsydir")
xvec(0) = xvec(0) + org(0)
xvec(1) = xvec(1) + org(1)
xvec(2) = xvec(2) + org(2)
yvec(0) = yvec(0) + org(0)
yvec(1) = yvec(1) + org(1)
yvec(2) = yvec(2) + org(2)

Set ucs = .UserCoordinateSystems.Add(org, xvec, yvec, "123")

.ActiveUCS = ucs
Dim blks As AcadBlocks
Dim blk As AcadBlock
Set blks = .Blocks
Dim baspt As Variant
Dim nor As Variant
Normal = NewPnt3d(0, 0, 1)
baspt = .Utility.TranslateCoordinates(NewPnt3d(0, 0, 0), acUCS, acWorld, False)

Set blk = blks.Add(NewPnt3d(0, 0, 0), "1")
Dim cir As AcadCircle
Set cir = blk.AddCircle(NewPnt3d(0, 0, 0), 10)
Normal = .Utility.TranslateCoordinates(NewPnt3d(0, 0, 1), acUCS, acWorld, False)
'cir.Normal = Normal
'cir.Update
Dim lne As AcadLine

Dim p2 As Variant
p2 = .Utility.TranslateCoordinates(NewPnt3d(10, 0, 0), acUCS, acOCS, False, Normal)

Set lne = blk.AddLine(NewPnt3d(0, 0, 0), NewPnt3d(10, 0, 0))

Dim blkref As AcadBlockReference

Set blkref = .ModelSpace.InsertBlock(NewPnt3d(0, 0, 0), blk.Name, 1, 1, 1, 0)

 

blkref.TransformBy ucs.GetUCSMatrix


blkref.Update
Dim xpt As Variant
xpt = .GetVariable("ucsxdir")

xpt = .Utility.TranslateCoordinates(xpt, acWorld, acOCS, False, Normal)

 

'Dim ang As Double
'ang = .Utility.AngleFromXAxis(baspt, xpt)
'MsgBox ang
'blkref.Rotate baspt, ang

End With

End Sub


Public Function Aspnt3d(pt As pnt3d) As Variant
Dim retu(2) As Double
retu(0) = pt.x: retu(1) = pt.y: retu(2) = pt.z
aspnt3 = retu
End Function

Public Function NewPnt3d(x As Double, y As Double, z As Double) As Variant
Dim retu(2) As Double
retu(0) = x: retu(1) = y: retu(2) = z
NewPnt3d = retu
End Function

 

Tags (1)
0 REPLIES 0

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost