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