namespace Model
open System
open Autodesk.AutoCAD.ApplicationServices
open Autodesk.AutoCAD.DatabaseServices
open Autodesk.AutoCAD.EditorInput
open Autodesk.AutoCAD.Geometry
open Autodesk.AutoCAD.Runtime
type AcAp = Autodesk.AutoCAD.ApplicationServices.Application
type AcEx = Autodesk.AutoCAD.Runtime.Exception
module Helpers =
let getObject<'a when 'a :> DBObject> (id : ObjectId) =
id.GetObject(OpenMode.ForRead) :?> 'a
let getObjects<'a when 'a :> DBObject> : System.Collections.IEnumerable -> _ =
let rxc = RXClass.GetClass(typeof<'a>)
| id when id.ObjectClass.IsDerivedFrom(rxc) -> Some(getObject<'a> id)
| _ -> None)
let addEntity (ent : #Entity) (btr : BlockTableRecord) =
if not btr.IsWriteEnabled then btr.UpgradeOpen()
let id = btr.AppendEntity(ent)
btr.Database.TransactionManager.AddNewlyCreatedDBObject(ent, true)
id
type OptionBuilder() =
member b.Bind(x, f) = Option.bind f x
member b.Return(x) = Some x
member b.Zero() = None
let opt = new OptionBuilder()
let failIfNotOk (pr : #PromptResult) =
opt { if pr.Status = PromptStatus.OK then return pr }
type Editor with
member ed.GetPoint(pt, msg) =
ed.GetPoint(new PromptPointOptions(msg, BasePoint = pt, UseBasePoint = true))
open Helpers
module CadWorker =
let getLayers () =
let db = HostApplicationServices.WorkingDatabase
use tr = db.TransactionManager.StartTransaction()
db.LayerTableId
|> getObject<LayerTable>
|> getObjects<LayerTableRecord>
|> Seq.map (fun l -> l.Name)
|> Seq.toArray
let drawLine (layer) =
let doc = AcAp.DocumentManager.MdiActiveDocument
let db = doc.Database
let ed = doc.Editor
let result = opt {
let! pr1 = failIfNotOk (ed.GetPoint("\nStart point: "))
let! pr2 = failIfNotOk (ed.GetPoint(pr1.Value, "\nEnd point: "))
return (pr1, pr2) }
match result with
| None -> ()
| Some (pr1, pr2) ->
use tr = db.TransactionManager.StartTransaction()
db.CurrentSpaceId
|> getObject<BlockTableRecord>
|> addEntity (new Line(pr1.Value, pr2.Value, Layer = layer)) |> ignore
tr.Commit();