Here's the code i'm using which works with the attched drawing. The last bit with hard coded values manipulates the block, i need a form to put the numbers in
Imports
Autodesk.AutoCAD.Runtime
Imports
Autodesk.AutoCAD
Imports
Autodesk.AutoCAD.DatabaseServices
Imports
Autodesk.AutoCAD.EditorInput
Imports
Autodesk.AutoCAD.Geometry
Imports
Autodesk.AutoCAD.ApplicationServices
Imports
Autodesk.AutoCAD.ApplicationServices.Application
Imports
Autodesk.AutoCAD.LayerManager
Imports
Autodesk.AutoCAD.Windows
Imports
System.Math
Public
ClassCommands
<
CommandMethod("DrawShed")> _
PublicSub DrawShed()
Dim recFrm AsNewShedForm()
Application.ShowModelessDialog(recFrm)
EndSub
End
Class
Public
ClassRectangle
PublicFunction InsertBlock(ByVal DatabaseIn AsDatabase, _
ByVal BTRToAddTo AsString, _
ByVal InsPt As Geometry.Point3d, _
ByVal BlockName AsString, _
ByVal XScale AsDouble, _
ByVal YScale AsDouble, _
ByVal ZScale AsDouble) As DatabaseServices.ObjectId
Using myTrans AsTransaction = DatabaseIn.TransactionManager.StartTransaction
Dim myBlockTable AsBlockTable = DatabaseIn.BlockTableId.GetObject(OpenMode.ForRead)
'If the suppplied Block Name is not
'in the specified Database, get out gracefully.
If myBlockTable.Has(BlockName) = FalseThen
ReturnNothing
EndIf
'If the specified BlockTableRecord does not exist,
'get out gracefully
If myBlockTable.Has(BTRToAddTo) = FalseThen
ReturnNothing
EndIf
Dim myBlockDef AsBlockTableRecord = _
myBlockTable(BlockName).GetObject(
OpenMode.ForRead)
Dim myBlockTableRecord AsBlockTableRecord = _
myBlockTable(BTRToAddTo).GetObject(
OpenMode.ForWrite)
'Create a new BlockReference
Dim myBlockRef AsNewBlockReference(InsPt, myBlockDef.Id)
'Set the scale factors
myBlockRef.ScaleFactors =
New Geometry.Scale3d(XScale, YScale, ZScale)
'Add the new BlockReference to the specified BlockTableRecord
myBlockTableRecord.AppendEntity(myBlockRef)
'Add the BlockReference to the BlockTableRecord.
myTrans.AddNewlyCreatedDBObject(myBlockRef,
True)
Dim myAttColl As DatabaseServices.AttributeCollection = _
myBlockRef.AttributeCollection
'Find Attributes and add them to the AttributeCollection
'of the BlockReference
ForEach myEntID AsObjectIdIn myBlockDef
Dim myEnt AsEntity = myEntID.GetObject(OpenMode.ForRead)
IfTypeOf myEnt Is DatabaseServices.AttributeDefinitionThen
Dim myAttDef As DatabaseServices.AttributeDefinition = myEnt
Dim myAttRef AsNew DatabaseServices.AttributeReference
myAttRef.SetAttributeFromBlock(myAttDef, myBlockRef.BlockTransform)
myAttColl.AppendAttribute(myAttRef)
myTrans.AddNewlyCreatedDBObject(myAttRef,
True)
EndIf
Next
myTrans.Commit()
Return myBlockRef.Id
EndUsing
EndFunction
Function SetParameter(ByVal BlockID AsObjectId, ByVal ParameterName AsString, _
ByVal Value AsDouble) AsBoolean
Using myTrans AsTransaction = BlockID.Database.TransactionManager.StartTransaction
Dim myBRef AsBlockReference = BlockID.GetObject(OpenMode.ForRead)
ForEach myDynamProp AsDynamicBlockReferencePropertyIn _
myBRef.DynamicBlockReferencePropertyCollection
If myDynamProp.PropertyName.Equals( _
ParameterName,
StringComparison.OrdinalIgnoreCase) = TrueThen
myDynamProp.Value = Value
myTrans.Commit()
ReturnTrue
Exit For
EndIf
Next
ReturnFalse
EndUsing
EndFunction
Private _length AsDouble
PublicProperty Length() AsDouble
Get
Return _length
EndGet
Set(ByVal value AsDouble)
_length = value
EndSet
EndProperty
Private _width AsDouble
PublicProperty Width() AsDouble
Get
Return _width
EndGet
Set(ByVal value AsDouble)
_width = value
EndSet
EndProperty
Private _height AsDouble
PublicProperty Height() AsDouble
Get
Return _height
EndGet
Set(ByVal value AsDouble)
_height = value
EndSet
EndProperty
Private _slope AsDouble
PublicProperty slope() AsDouble
Get
Return _slope
EndGet
Set(ByVal value AsDouble)
_slope = value
EndSet
EndProperty
SubNew(ByVal length AsDouble, ByVal width AsDouble, ByVal height AsDouble, ByVal slope AsDouble)
Me.Length = length
Me.Width = width
Me.Height = height
Me.slope = slope
EndSub
PublicSub InsertBlockSetPointParameter()
Dim doc AsDocument = Application.DocumentManager.MdiActiveDocument
Dim db AsDatabase = doc.Database
Dim radians AsDouble = slope * PI / 180
Dim RL AsDouble = Tan(radians) * (Width / 2)
Dim TP AsDouble = Height + RL
Dim myBlockID AsObjectId = InsertBlock(HostApplicationServices.WorkingDatabase, _
BlockTableRecord.ModelSpace, _
NewPoint3d(1, 1, 0), "Plan_Base", 1, 1, 1)
SetParameter(myBlockID,
"P_Len", Length)
SetParameter(myBlockID,
"P_Width", Width)
SetParameter(myBlockID,
"Ridge_Height_LE", TP)
SetParameter(myBlockID,
"Ridge_Height_RE", TP)
SetParameter(myBlockID,
"Shed_Height_LE", Height)
SetParameter(myBlockID,
"Shed_Height_RE", Height)
SetParameter(myBlockID,
"Shed_Height_Front", Height)
SetParameter(myBlockID,
"Ridge_Height_Front", TP)
SetParameter(myBlockID,
"Shed_Height_Back", Height)
SetParameter(myBlockID,
"Ridge_Height_Back", TP)
EndSub
End
Class
Creative Intentions
AutoCAD Certified Professional
Win 10 Pro 64bit, HP ZBook 17
