open Autodesk.AutoCAD.ApplicationServices
open Autodesk.AutoCAD.Runtime
open Autodesk.AutoCAD.DatabaseServices
open Autodesk.AutoCAD.Geometry
open Autodesk.AutoCAD.EditorInput
open Autodesk.AutoCAD.BoundaryRepresentation
let Init()=
let doc=Application.DocumentManager.MdiActiveDocument
doc,doc.Editor,doc.Database,doc.TransactionManager.StartTransaction
let RegExplode (rg:Region)=
let brep=new Brep(rg)
seq{for f in brep.Faces->f}|>function
|faces when faces|>Seq.skip 1|>Seq.isEmpty->[rg]
|_->let coll=new DBObjectCollection()
rg.Explode(coll)
rg.Dispose()
[for x in coll->x:?>Region]
let IndexRegion (rg:Region) width height=
let deltaX=width/10.0
let deltaY=height/10.0
let x0,y0=let pt=rg.GeometricExtents.MinPoint
pt.X,pt.Y
use br=new Brep(rg)
seq{for face in br.Faces->
seq{for lop in face.Loops->
seq{for edge in lop.Edges->
use curve=edge.Curve
let intr=curve.GetInterval()
let p1,p2=intr.LowerBound,intr.UpperBound
{p1..(p2-p1)/(curve.GetLength(p1,p2,(min deltaX deltaY)/2.0)/(min deltaX deltaY))..p2}
|>Seq.map (curve.EvaluatePoint)|>Seq.toArray}}}
|>Seq.concat|>Seq.concat|>Seq.concat //seq point3d
|>Seq.fold (fun set pt->let x,y=(pt.X-x0)/width,(pt.Y-y0)/height
set|>Set.add(x|>int,y|>int)
|>Set.add(x|>int,y+0.1|>int)
|>Set.add(x|>int,y-0.1|>int)
|>Set.add(x+0.1|>int,y|>int)
|>Set.add(x+0.1|>int,y+0.1|>int)
|>Set.add(x+0.1|>int,y-0.1|>int)
|>Set.add(x-0.1|>int,y|>int)
|>Set.add(x-0.1|>int,y+0.1|>int)
|>Set.add(x-0.1|>int,y-0.1|>int))
(Set [])
let MakeRegion (pt1:Point3d) width height=
let cl=new DBObjectCollection()
new Polyline2d(Poly2dType.SimplePoly,new Point3dCollection([|pt1
new Point3d(pt1.X+width,pt1.Y,pt1.Z)
new Point3d(pt1.X+width,pt1.Y+height,pt1.Z)
new Point3d(pt1.X,pt1.Y+height,pt1.Z)|]),
0.0,true,0.0,0.0,new DoubleCollection([|0.0;0.0;0.0;0.0|]))|>cl.Add|>ignore
Region.CreateFromCurves(cl).[0]:?>Region
[<CommandMethod "Narez">]
let Narez()=
let doc,ed,db,trf=Init()
let Slice width height id=
let start=System.DateTime.Now
use tr=trf()
let rg=tr.GetObject(id,OpenMode.ForWrite):?>Region
let ext=rg.GeometricExtents
let block=tr.GetObject(rg.BlockId,OpenMode.ForWrite):?>BlockTableRecord
let AppendEnt (ent:Entity)=
block.AppendEntity ent|>ignore
tr.AddNewlyCreatedDBObject(ent,true)
let obr=MakeRegion ext.MinPoint width height
let mtw=Matrix3d.Displacement(new Vector3d(width,0.0,0.0))
let mth=Matrix3d.Displacement(new Vector3d(-width*(((ext.MaxPoint.X-ext.MinPoint.X)/width|>int)+1|>float),height,0.0))
let index=IndexRegion rg width height
"\n"+string(System.DateTime.Now-start)+" - индексация выполненна; "|>ed.WriteMessage
{0..(ext.MaxPoint.Y-ext.MinPoint.Y)/height|>int}
|>Seq.iter (fun y ->{0..(ext.MaxPoint.X-ext.MinPoint.X)/width|>int}
|>Seq.fold (fun (next,check) x ->
(Set.contains (x,y) index,next,check)|>function
|true,_,_->let cl=(obr.Clone():?>Region)
obr.TransformBy(mtw)
cl.BooleanOperation(BooleanOperationType.BoolIntersect,rg.Clone():?>Region)
if cl.Area<0.0001
then cl.Dispose()
else cl|>RegExplode|>Seq.iter AppendEnt
false,true
|_,_,true->let cl=(obr.Clone():?>Region)
obr.TransformBy(mtw)
cl.BooleanOperation(BooleanOperationType.BoolIntersect,rg.Clone():?>Region)
if cl.Area<0.0001
then cl.Dispose()
false,false
else cl|>RegExplode|>Seq.iter AppendEnt
true,false
|_,true,_->let cl=(obr.Clone():?>Region)
obr.TransformBy(mtw)
AppendEnt cl
true,false
|_->obr.TransformBy(mtw)
false,false) (false,false)|>ignore
obr.TransformBy(mth))
obr.Dispose()
tr.Commit()
"всего затраченно: "+string(System.DateTime.Now-start)+"\n"|>ed.WriteMessage
let inline (|PromptOk|_|) (pr:^a)=(^a:(member Status:PromptStatus)pr)=PromptStatus.OK|>function
|true->Some(pr)
|false->None
let ErrInput()=ed.WriteMessage("\nКоманда отменена")
ed.GetSelection(new SelectionFilter([|new TypedValue(int(DxfCode.Start),"REGION")|]))|>function
|PromptOk(ss)->ed.GetDistance("\nШирина: ")|>function
|PromptOk(width)->ed.GetDistance("\nВысота:")|>function
|PromptOk(height)->let start=System.DateTime.Now
seq{for ssid in ss.Value->ssid.ObjectId}
|>Seq.iter (Slice width.Value height.Value)
"\nОбщее время: "+string(System.DateTime.Now-start)|>ed.WriteMessage
|_->ErrInput()
|_->ErrInput()
|_->ErrInput()
