1 {
2 *****************************************************************************
3 *                                                                           *
4 *  This file is part of the ZCAD                                            *
5 *                                                                           *
6 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
7 *  for details about the copyright.                                         *
8 *                                                                           *
9 *  This program is distributed in the hope that it will be useful,          *
10 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
11 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
12 *                                                                           *
13 *****************************************************************************
14 }
15 {**
16 @author(Andrey Zubarev <zamtmn@yandex.ru>)
17 }
18 {$mode delphi}//need delphi mode for disable type checking in interactive manipulators
19 
20 {**Примерный модуль реализации чертежных команд (линия, круг, размеры и т.д.)
21    Ничего не экспортирует, содержит некоторые команды доступные в зкаде}
22 unit uzccomdrawsuperline;
23 
24 { file def.inc is necessary to include at the beginning of each module zcad
25   it contains a centralized compilation parameters settings }
26 
27 { файл def.inc необходимо включать в начале каждого модуля zcad
28   он содержит в себе централизованные настройки параметров компиляции  }
29 
30 {$INCLUDE def.inc}
31 
32 interface
33 uses
34 
35   { uses units, the list will vary depending on the required entities
36     and actions }
37   { подключеные модули, список будет меняться в зависимости от требуемых
38     примитивов и действий с ними }
39 
40   sysutils,
41 
42   uzccominteractivemanipulators,
43 
44   uzbgeomtypes,
45 
46   uzcinterface,
47 
48   uzeentline,             //unit describes line entity
49                        //модуль описывающий примитив линия
50   uzventsuperline,uzcenitiesvariablesextender,UUnitManager,uzbpaths,uzctranslations,
51 
52   uzeentityfactory,    //unit describing a "factory" to create primitives
53                       //модуль описывающий "фабрику" для создания примитивов
54   uzbtypesbase,uzbtypes, //base types
55                       //описания базовых типов
56   uzeconsts, //base constants
57                       //описания базовых констант
58   uzccommandsmanager,
59   uzccommandsabstract,
60   uzccommandsimpl, //Commands manager and related objects
61                       //менеджер команд и объекты связанные с ним
62   uzcdrawings,     //Drawings manager, all open drawings are processed him
63                       //"Менеджер" чертежей
64   uzcutils,         //different functions simplify the creation entities, while there are very few
65                       //разные функции упрощающие создание примитивов, пока их там очень мало
66   uzestyleslayers,
67   varmandef,
68   Varman,UBaseTypeDescriptor,uzbstrproc,
69 
70   uzcstrconsts;       //resouce strings
71 
72 
73 type
74 PTDrawSuperlineParams=^TDrawSuperlineParams;
75 TDrawSuperlineParams=packed record
76                          pu:PTUnit;                //рантайм юнит с параметрами суперлинии
77                          LayerNamePrefix:GDBString;//префикс
78                          ProcessLayer:GDBBoolean;  //выключатель
79                      end;
80 var
81    DrawSuperlineParams:TDrawSuperlineParams;
82 
createSuperLinenull83    function createSuperLine(p1,p2:GDBVertex;nameSL:string;changeLayer:boolean;LayerNamePrefix:string):TCommandResult;
84 
85 implementation
86 
GetInteractiveLinenull87 function GetInteractiveLine(prompt1,prompt2:GDBString;out p1,p2:GDBVertex):GDBBoolean;
88 var
89     pline:PGDBObjLine;
90 begin
91     result:=false;
92     if commandmanager.get3dpoint(prompt1,p1) then
93     begin
94          pline := GDBPointer(drawings.GetCurrentDWG^.ConstructObjRoot.ObjArray.CreateInitObj(GDBLineID,drawings.GetCurrentROOT));
95          pline^.CoordInOCS.lBegin:=p1;
96          InteractiveLineEndManipulator(pline,p1,false);
97       if commandmanager.Get3DPointInteractive(prompt2,p2,@InteractiveLineEndManipulator,pline) then
98       begin
99            result:=true;
100       end;
101     end;
102     drawings.GetCurrentDWG^.FreeConstructionObjects;
103 end;
GetInteractiveLineFrom1to2null104 function GetInteractiveLineFrom1to2(prompt2:GDBString;const p1:GDBVertex; out p2:GDBVertex):GDBBoolean;
105 var
106     pline:PGDBObjLine;
107 begin
108     pline := GDBPointer(drawings.GetCurrentDWG^.ConstructObjRoot.ObjArray.CreateInitObj(GDBLineID,drawings.GetCurrentROOT));
109     pline^.CoordInOCS.lBegin:=p1;
110     InteractiveLineEndManipulator(pline,p1,false);
111     result:=commandmanager.Get3DPointInteractive(prompt2,p2,@InteractiveLineEndManipulator,pline);
112     drawings.GetCurrentDWG^.FreeConstructionObjects;
113 end;
createSuperLinenull114 function createSuperLine(p1,p2:GDBVertex;nameSL:string;changeLayer:boolean;LayerNamePrefix:string):TCommandResult;
115 var
116     psuperline:PGDBObjSuperLine;
117     pvarext:PTVariablesExtender;
118     psu:ptunit;
119     pvd:pvardesk;        //для нахождения имени суперлинии
120     layername:gdbstring; //имя слоя куда будет помещена супелиния
121     player:PGDBLayerProp;//указатель на слой куда будет помещена супелиния
122 begin
123     psuperline := AllocEnt(GDBSuperLineID);
124     psuperline^.init(nil,nil,0,p1,p2);
125     pvarext:=psuperline^.GetExtension(typeof(TVariablesExtender));
126     if pvarext<>nil then
127     begin
128       psu:=units.findunit(SupportPath,InterfaceTranslate,'superline');
129       if psu<>nil then
130         pvarext^.entityunit.copyfrom(psu);
131     end;
132     zcSetEntPropFromCurrentDrawingProp(psuperline);           //присваиваем умолчательные значения
133 
134 
135     //если манипуляции со слоем включены и ранее был найден "юнит" с параметрами
136     if (changeLayer)and(psu<>nil) then
137     begin
138       //ищем переменную 'NMO_Name'
139       pvd:=psu.FindVariable('NMO_Name');
140       pgdbstring(pvd^.data.Instance)^:=nameSL;
141       //если найдена
142       if pvd<>nil then
143       begin
144         //получаем желаемое имя слоя
145         layername:=LayerNamePrefix+nameSL;
146         //pvd.data.PTD^.GetValueAsString(pvd.data.Instance);
147         //ищем описание слоя по имени
148 
149         player:=drawings.GetCurrentDWG.LayerTable.getAddres(Tria_Utf8ToAnsi(layername));
150         //если найден - присваиваем, иначе ругаемя
151         if player<>nil then
152                            psuperline.vp.Layer:=player
153                        else
154                            ZCMsgCallBackInterface.TextMessage(format('Layer "%s" not found',[layername]),TMWOHistoryOut);
155       end;
156     end;
157     //zcPlaceUndoStartMarkerIfNeed(UndoMarcerIsPlazed,'DrawSuperLine');
158     zcAddEntToCurrentDrawingWithUndo(psuperline);
159     zcRedrawCurrentDrawing;
160 end;
161 
DrawSuperLine_comnull162 function DrawSuperLine_com(operands:TCommandOperands):TCommandResult;
163 var
164     psuperline:PGDBObjSuperLine;
165     p1,p2:gdbvertex;
166     pvarext:PTVariablesExtender;
167     psu:ptunit;
168     UndoMarcerIsPlazed:boolean;
169 
170 procedure createline;
171 var
172     pvd:pvardesk;        //для нахождения имени суперлинии
173     layername:gdbstring; //имя слоя куда будет помещена супелиния
174     player:PGDBLayerProp;//указатель на слой куда будет помещена супелиния
175 begin
176     psuperline := AllocEnt(GDBSuperLineID);
177     psuperline^.init(nil,nil,0,p1,p2);
178     pvarext:=psuperline^.GetExtension(typeof(TVariablesExtender));
179     if pvarext<>nil then
180     begin
181       psu:=units.findunit(SupportPath,InterfaceTranslate,'superline');
182       if psu<>nil then
183         pvarext^.entityunit.copyfrom(psu);
184     end;
185     zcSetEntPropFromCurrentDrawingProp(psuperline);           //присваиваем умолчательные значения
186     //если манипуляции со слоем включены и ранее был найден "юнит" с параметрами
187     if (DrawSuperlineParams.ProcessLayer)and(psu<>nil) then
188     begin
189       //ищем переменную 'NMO_Name'
190       pvd:=psu.FindVariable('NMO_Name');
191       //если найдена
192       if pvd<>nil then
193       begin
194         //получаем желаемое имя слоя
195         layername:=DrawSuperlineParams.LayerNamePrefix+pvd.data.PTD^.GetValueAsString(pvd.data.Instance);
196         //ищем описание слоя по имени
197 
198         player:=drawings.GetCurrentDWG.LayerTable.getAddres(Tria_Utf8ToAnsi(layername));
199         //если найден - присваиваем, иначе ругаемя
200         if player<>nil then
201                            psuperline.vp.Layer:=player
202                        else
203                            ZCMsgCallBackInterface.TextMessage(format('Layer "%s" not found',[layername]),TMWOHistoryOut);
204       end;
205     end;
206     zcPlaceUndoStartMarkerIfNeed(UndoMarcerIsPlazed,'DrawSuperLine');
207     zcAddEntToCurrentDrawingWithUndo(psuperline);
208     zcRedrawCurrentDrawing;
209 end;
210 
211 begin
212     psu:=units.findunit(SupportPath,InterfaceTranslate,'superline');
213     DrawSuperlineParams.pu:=psu;
214     zcShowCommandParams(pointer(SysUnit^.TypeName2PTD('TDrawSuperlineParams')),@DrawSuperlineParams);
215     UndoMarcerIsPlazed:=false;
216     if GetInteractiveLine(rscmSpecifyFirstPoint,rscmSpecifySecondPoint,p1,p2) then
217     begin
218       createline;
219       p1:=p2;
220       while GetInteractiveLineFrom1to2(rscmSpecifySecondPoint,p1,p2)do
221       begin
222        createline;
223        p1:=p2;
224       end;
225     end;
226     zcPlaceUndoEndMarkerIfNeed(UndoMarcerIsPlazed);
227     result:=cmd_ok;
228 end;
229 initialization
230      SysUnit.RegisterType(TypeInfo(TDrawSuperlineParams));//регистрируем тип данных в зкадном RTTI
231      SysUnit.SetTypeDesk(TypeInfo(TDrawSuperlineParams),['SuperLineUnit','Layer name prefix','Layer change']);//даем человеческие имена параметрам
232      DrawSuperlineParams.LayerNamePrefix:='SYS_SL_';//начальное значение префикса
233      DrawSuperlineParams.ProcessLayer:=true;        //начальное значение выключателя
234      CreateCommandFastObjectPlugin(@DrawSuperLine_com,   'DrawSuperLine',   CADWG,0);
235 end.
236