将文本转换为属性

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 then IsText so.ObjectId 
    elif isClass so typeof[B] 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
[]
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  ()
    // Set up selection options and keyword. Select with filter
    let pso = new PromptSelectionOptions(AllowDuplicates = false)
    pso.Keywords.Add "attribute Tag"
    pso.MessageForAdding  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  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
    | _ -> ()