Hello friends!
My objective is to add a text to a block reference as an attribute. The code below seems to work.
As I'm Csharply challenged, it's in F# again. Apologies.
I'd like to know if there are better approaches than
1) selecting the objects via a filtered selection set, and
2) avoiding the tedious initialization of all relevant text properties in the new attref (am I missing any?).
That is, since AttributeReference inherits from DBText, there might be a more elegant way.
open Autodesk.AutoCAD.DatabaseServices
open Autodesk.AutoCAD.EditorInput
open Autodesk.AutoCAD.Geometry
open Autodesk.AutoCAD.Runtime
type acApp = Autodesk.AutoCAD.ApplicationServices.Application
// Helper pattern to check for ObjectId RXClass
let isClass (so: SelectedObject) =
RXClass.GetClass >> so.ObjectId.ObjectClass.IsDerivedFrom
let (|IsText|IsInsert|Other|) so =
if isClass so typeof<DBText> then IsText so.ObjectId
elif isClass so typeof<BlockReference> then IsInsert so.ObjectId
else Other
// Handler for filtering
let txBrFilter (e: SelectionAddedEventArgs) =
e.AddedObjects
|> Seq.cast<_>
|> Seq.mapi
(fun i so -> match so with IsText _ | IsInsert _ -> None | _ -> Some i)
|> Seq.choose id
|> Seq.iter e.Remove
// Extension for filter handler selection. Returns Some when exactly
// two objects are selected
type Editor with
member ed.TrySelectWithFilter (pso: PromptSelectionOptions) =
let obs = ed.SelectionAdded |> Observable.subscribe txBrFilter
let psr = ed.GetSelection pso
obs.Dispose()
match psr.Status with
| PromptStatus.OK when psr.Value.Count = 2 ->
Some(psr.Value.[0], psr.Value.[1])
| _ -> None
// Static repository for user-supplied attribute tag
// (accessible over multiple documents)
let mutable tag = ""
// Our command converts an existing DBText object to an AttributeReference
// and attaches it to the AttributeCollection of an existing block reference.
// If successful, the text will be erased
[<CommandMethod("T2A", CommandFlags.UsePickSet)>]
let Text2AttributeReference() =
// the usual suspects
let doc = acApp.DocumentManager.MdiActiveDocument
let ed = doc.Editor
let db = doc.Database
// Function for attribute tag input
let getAttTag() =
let pso =
new PromptStringOptions(
"\nEnter attribute tag: ",
AllowSpaces = false )
if tag <> "" then
pso.DefaultValue <- tag
pso.UseDefaultValue <- true
let pr = ed.GetString pso
match pr.Status with
| PromptStatus.OK -> tag <- pr.StringResult.ToUpper()
| _ -> ()
// Set up selection options and keyword. Select with filter
let pso = new PromptSelectionOptions(AllowDuplicates = false)
pso.Keywords.Add "attribute Tag"
pso.MessageForAdding <-
"\nSelect block reference and text or " +
pso.Keywords.GetDisplayString true
pso.KeywordInput |> Observable.add (fun _ -> getAttTag())
let res = ed.TrySelectWithFilter pso
// If not yet supplied, get the tag now
if tag = "" then getAttTag()
// Evaluate user input
match res with
| Some(IsText tid, IsInsert bid)
| Some(IsInsert bid, IsText tid) when tag <> "" ->
use tr = db.TransactionManager.StartTransaction()
let tx = tr.GetObject(tid, OpenMode.ForWrite) :?> DBText
let br = tr.GetObject(bid, OpenMode.ForWrite) :?> BlockReference
// Iterate thru attribute collection and check for existing tag
let dupatt =
br.AttributeCollection
|> Seq.cast<_>
|> Seq.exists
(fun aid ->
let ar =
tr.GetObject(aid, OpenMode.ForRead)
:?> AttributeReference
ar.Tag = tag )
// If all is well, let's go
if not dupatt then
try
let ar =
new AttributeReference(
Tag = tag,
Color = tx.Color,
Height = tx.Height,
Justify = tx.Justify,
Layer = tx.Layer,
LinetypeId = tx.LinetypeId,
LinetypeScale = tx.LinetypeScale,
LineWeight = tx.LineWeight,
Normal = tx.Normal,
Oblique = tx.Oblique,
Position = tx.Position,
Rotation = tx.Rotation,
TextString = tx.TextString,
// TextStyle = tx.TextStyle, // 2009
TextStyleId = tx.TextStyleId, // 2010
WidthFactor = tx.WidthFactor )
if tx.Justify <> AttachmentPoint.BaseLeft then
ar.AlignmentPoint <- tx.AlignmentPoint
br.AttributeCollection.AppendAttribute ar |> ignore
tr.AddNewlyCreatedDBObject(ar, true)
tx.Erase()
with ex ->
"\nError creating attribute reference: " +
ex.Message
|> ed.WriteMessage
else
"\nAttribute tag \"" + tag +
"\" already used in block \"" + br.Name + "\" "
|> ed.WriteMessage
tr.Commit()
| Some _ ->
"\nSelect one block reference and one text object only. "
|> ed.WriteMessage
| _ -> ()
Cheers!
