module LispFun
open System
open Autodesk.AutoCAD.ApplicationServices
open Autodesk.AutoCAD.DatabaseServices
open Autodesk.AutoCAD.EditorInput
open Autodesk.AutoCAD.Geometry
open Autodesk.AutoCAD.Runtime
//функция преобразования переданных аргументов в список
//список имеет более широкие возможности сопоставления чем массив
//т.к. возможно сопоставить только "начальные" аргументы
//реализованна с помощью шаблона сопоставления
let Rb=function
|null->[] // если ничего нет - то пустой список
|
(rb:ResultBuffer
)->rb.
AsArray()|>Array.
toList //если что-то передали - список аргументов
//создадим полный шаблон на некоторые типы данных
//возможно дополнение в этом либо другом шаблоне
//перегрузка Unknow - для "необработанных" типов данных
let (|Str|Num|T|Nil|Id|Point|Unknow|) (tv:TypedValue)=
enum<LispDataType>(tv.TypeCode|>int)|>function
|LispDataType.Text->Str(tv.Value:?>string) // если передан тип строка - преобразуем в строку
|LispDataType.Double->Num(tv.Value:?>float) // число в любом формате приведем к float
|LispDataType.Int16->Num(tv.Value:?>int16|>float)
|LispDataType.Int32->Num(tv.Value:?>int32|>float)
|LispDataType.T_atom->T // по аналогии остальные типы ...
|LispDataType.Nil->Nil
|LispDataType.ObjectId->Id(tv.Value:?>ObjectId)
|LispDataType.Point3d->Point(tv.Value:?>Point3d)
|_->Unknow
let (|LstB|LstE|Ss|Unknow|) (tv:TypedValue)= // шаблон на SelectionSet и начало/конец списка
enum<LispDataType>(tv.TypeCode|>int)|>function
|LispDataType.ListBegin->LstB
|LispDataType.ListEnd->LstE
|LispDataType.SelectionSet->Ss([for id in (tv.Value:?>SelectionSet)->id.ObjectId])
|_->Unknow
let (|AcList|_|)=function // неполный шаблон - на содержимое списка с учетом вложенных
|LstB::t->let rec fn=function // если начало списка - создаем функцию разбора списка
|lst,
0,LstE::t
->Some
(lst
|>List.
rev,t
) //уровень вложенности = 0 и получаем конец списка // - возвращаем список и данные идущие за ним
|lst,x,(LstB as s)::t->fn(s::lst,x+1,t) // начало вложенного списка - повышаем уровень
|lst,x,(LstE as e)::t->fn(e::lst,x-1,t) // конец вложенного списка - понижаем
|lst,x,a::b->fn(a::lst,x,b) // непосредственно данные
|_->failwith "Ошибка разбора" // при передачи из лисп сюда программа никак не должна попасть
fn([],0,t) // запуск функцию разбора
|_->None // не соответствие шаблону
let (|Dxf|_|) code=function // неполный шаблон на сопоставление dxf кода переданного Entity
|Id id when id.ObjectClass.DxfName=code->Some(id)
|_->None // другой вча код или другой тип аргумента
let (|Line|PLine|Arc|Circle|Unknow|)=function //Шаблон на некоторые примитивы
//с отложенным получением приведенных объектов
|Dxf "LINE" id->Line(lazy(id.GetObject(OpenMode.ForRead):?>Line))
|Dxf "LWPOLYLINE" id->PLine(lazy(id.GetObject(OpenMode.ForRead):?>Polyline))
|Dxf "ARC" id->Arc(lazy(id.GetObject(OpenMode.ForRead):?>Arc))
|Dxf "CIRCLE" id->Circle(lazy(id.GetObject(OpenMode.ForRead):?>Circle))
|_->Unknow
// функции преобразования данных для возврата из lisp функции
let Str x=new TypedValue(int LispDataType.Text,x)
let Num x=new TypedValue(int LispDataType.Double,x)
let T=new TypedValue(int LispDataType.T_atom)
let Nil=new TypedValue(int LispDataType.Nil)
[<LispFunction "XFun">]
let XFun arg= //сама функция
Application.DocumentManager.MdiActiveDocument|>function
|null->Nil //если нет активного документа
|doc->let ed,db,trf=doc.Editor,doc.Database,doc.TransactionManager.StartTransaction
arg|>Rb|>function //переводим ResultBuffer в список и начинаем сопоставления
// первый шаблон - это два числа
|[Num a;Num b]->"\nСумма двух чисел "|>ed.WriteMessage
a+b|>Num //возвращаем число из приведенных чисел
// аналогично - две строки
|[Str a;Str b]->"\nСцепление двух строк "|>ed.WriteMessage
a+b|>Str
//Entity c DXF кодом "LINE"
|Dxf
"LINE" line::t
->String.
Format("Получена линия с дескриптором {0}.",line.
Handle)|>Str
|Str "Средняя точка"::AcList([Point pt1;Point pt2; Point pt3],[])->
"\nВычисляем из списка трех точек "|>ed.WriteMessage
(pt1.X+pt2.Y+pt3.Z)|>Num
|Num a::AcList(lst,[])->"\nЧисло и список "|>ed.WriteMessage
a
+float(lst
|>List.
length)|>Num
// если окружность и дуга или в обратном порядке (дуга, окружность)
|Circle circ::Arc arc::t|Arc arc::Circle circ::t->
use tr=trf() //вызовем транзакцию внутри которой будут выполнены отложенные вычисления
let ret=circ.Value.Center.DistanceTo(arc.Value.Center)
tr.Commit()
"\nРассстояние между окружностью и дугой "|>ed.WriteMessage
ret|>Num
|Str "Сколько аргументов"::t->
let rec ArgCount=function
|[]->0
|AcList(lst,b)->1+ArgCount(b)
|a::b->1+ArgCount(b)
String.
Format("Количество аргументов={0}, кроме первого",ArgCount t
)|>Str
|lst
when lst
|>List.
forall (function |Ss _
->true //проверка что все аргументы - имеют тип SelectionSet |_->false)->
"\nКоличество уникальных объектов в наборах "|>ed.WriteMessage
lst
|>List.
collect (function|Ss lst
->lst
|_->[])
|>Seq.
distinct|>Seq.
length|>Num
|_->"\nНеизвестный набор параметров "|>ed.WriteMessage
Nil // если ни один шаблон не совпал
