Liren Large Software Subsidy 13

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 13 / 13.iso / p / p115 / 10.ddi / GCD4 / UPL / INSCL.UPL < prev next >

Wrap

Text File | 1989-03-06 | 20.9 KB | 594 lines

--INSCL.UPL --03/01/89 NCC PRP/PRL fix ------------------------------------------------------------------------------ -- This UPL program was designed and written by: -- -- 4D Graphics, Inc., 1800 NE 44th St., Suite 210, Renton, WA 98056 -- -- -- -- Do not remove this notice from this file. -- ------------------------------------------------------------------------------ --This UPL program implements a new GCD command via UPL to insert construction --lines in more ways than is availiable with the 'INS LIN CLINE' GCD command. --When installed in the VNP command table it will execute just like any other --GCD command. $DataSize 2000 --this reduces the memory requirements of UPL, at most --we only use about 1500 bytes for data, the default value --of DataSize is 20000 group --data used by several procedures const integer MaxEnt = 400, CR = 13, Abort = 3, Colon = 58 const string HelpFile = 'INSCL.HLP' integer EntData(5), CurrentCPL real AngVal, DistVal, VwTrans(15) coord VwZ @ VwTrans+26 boolean Horiz=False, Vert=False, Prl=False, Prp=False, Angle=False, \ Distance=False, Cir=False, Mid=False, Equi=False end group proc SetupModifiers----------------------------------------------------------- --This procedure sets up the modifier words. It is only called once. DefineModifier( 1,'HORizontal', 'A',Horiz, 0.0) DefineModifier( 2,'VERtical', 'A',Vert, 0.0) DefineModifier( 3,'PRL', 'A',Prl, 0.0) DefineModifier( 4,'PRP', 'A',Prp, 0.0) DefineModifier( 5,'MIDway', 'A',Mid, 0.0) DefineModifier( 6,'EQUIPrl', 'A',Equi, 0.0) DefineModifier( 7,'CIRcle', 'B',Cir, 0.0) DefineModifier( 8,'NOCIRcle', 'B',True, 0.0) AngVal = 45.0 --default angle for ANGle modifier DistVal = 1.0 --default distance for DISTance modifier EntData(5) = 9 DefineModifier(11,'COLor', 'I', False, Real(EntData(5))) EntData(4) = 3 DefineModifier(12,'FONt', 'I', False, Real(EntData(4))) EntData(1) = 256 DefineModifier(13,'LAYer', 'I', False, Real(EntData(1))) end proc---------------------------------------------------------------------- proc ModifierProcessor-------------------------------------------------------- --This procedure puts the user in the modifier processor and after the --user enters a <CR>, ':' or ^C will return and then the values the --user entered are gotten. boolean Selected real R string SVal:1 --always reset ANGle and DISTance modifiers to false (unselected) DefineModifier( 9,'ANGle', 'R',False, AngVal) DefineModifier(10,'DISTance', 'R',False, DistVal) SetHelp(HelpFile, 1,0,1) --set up help indexs AskModifiers(0) --get modifier values from user return when LastChar = Abort or LastChar = CR GetModifier( 1, Horiz, R, SVal) GetModifier( 2, Vert, R, SVal) GetModifier( 3, Prl, R, SVal) GetModifier( 4, Prp, R, SVal) GetModifier( 5, Mid, R, SVal) GetModifier( 6, Equi, R, SVal) GetModifier( 7, Cir, R, SVal) GetModifier( 8, Selected, R, SVal) GetModifier( 9, Angle, AngVal, SVal) GetModifier(10, Distance, DistVal, SVal) GetModifier(11, Selected, R, SVal); EntData(5) = Integer(R) GetModifier(12, Selected, R, SVal); EntData(4) = Integer(R) GetModifier(13, Selected, R, SVal); EntData(1) = Integer(R) end proc---------------------------------------------------------------------- proc WarnMsg(In String Msg:80)------------------------------------------------ TextColor(115) --use warning message color print; print Msg --display message TextColor(106) --return to standard color end proc---------------------------------------------------------------------- func CoordEq(coord C1, C2) return boolean------------------------------------- --This function determines if 2 coord values are nearly equal const real Tol = 0.00001 return abs(C2.X-C1.X) < Tol and \ abs(C2.Y-C1.Y) < Tol and \ abs(C2.Z-C1.Z) < Tol end func---------------------------------------------------------------------- proc PrpIt(coord End1, End2, Pnt; InOut PrpPnt)----------------------------- --Pnt lies on the line from End1 to End2 so we have to do the --opposite inverse slope thing to find a prp line --NOTE: line endpoints are allready in view space coord SlopeVec if (End1.X = End2.X) then --The prp slope is 0 PrpPnt.X = Pnt.X + 1.0 PrpPnt.Y = Pnt.Y PrpPnt.Z = Pnt.Z else if (End1.Y = End2.Y) then --The prp slope is infinite PrpPnt.X = Pnt.X PrpPnt.Y = Pnt.Y + 1.0 PrpPnt.Z = Pnt.Z else --Some non-trivial slope -- vector equation is PrpPnt = Pnt + t * SlopeVec PrpPnt.X = - (End2.Y - End1.Y) PrpPnt.Y = End2.X - End1.X --PrpPnt.Z = End2.Z - End1.Z PrpPnt.Z = 0.0 SlopeVec = vunit(PrpPnt) PrpPnt = Pnt + SlopeVec endif end proc---------------------------------------------------------------------- proc PntPrp2(coord End1, End2, Pnt; InOut PrpPnt)----------------------------- --This procedure fixes an anomoly in the intrinsic PntPrp routine PntPrp(End1, End2, Pnt, PrpPnt) if CoordEq(Pnt,PrpPnt) then PrpIt(End1, End2, Pnt, PrpPnt) endif end proc---------------------------------------------------------------------- func PrlLine(coord End1, End2, End3, End4) return boolean--------------------- --This function determines if the line End1-End2 is parallel to End3-End4 End1 = vunit(End2-End1); End2 = vunit(End4-End3) return CoordEq(End1,End2) or CoordEq(End1,-End2) end func---------------------------------------------------------------------- func CoLinear(coord End1, End2, End3, End4) return boolean-------------------- --This function determines if the line End1-End2 is colinear to the --line End3-End4 if PrlLine(End1, End2, End3, End4) then PntPrp2(End1, End2, End3, End4) return vlen(End3, End4) = 0.0 else return false endif end func---------------------------------------------------------------------- proc InsCLine(in coord LineEnd1, LineEnd2)------------------------------------ --This procedure adds a new construction line to the database integer NewMib, err Addent(15, EntData(1), NewMib, err) --entity type 15 is a CLINE WSubrecXZ(NewMib, err, MapVM(LineEnd1), MapVM(LineEnd2)) RpntEnt(NewMib, 1, err) --show it on the screen end proc---------------------------------------------------------------------- proc GetLineEnds(inout integer LinMib; coord End1, End2)---------------------------- --This procedure gets a line or construction line integer NEnts, IEnd, err EntMask(0); EntMask(1); EntMask(15) --allow only lines to be picked SetHelp(HelpFile, 1,1,1) --set up getdata help index print 'pick a line ', GetEnt(1, NEnts, LinMib, IEnd) return when LastChar = Abort or LastChar = CR or NEnts <> 1 if LastChar = Colon then RpntEnt(LinMib, 1, err) endif RSubRecXZ(LinMib, 1, err, End1, End2) --get the endpoints End1 = MapMV(End1); End2 = MapMV(End2) --convert them to view space end proc---------------------------------------------------------------------- proc MakeCircleCL(coord End1, End2)------------------------------------------- --This procedure is used to insert construction lines when the CIRcle --modifer is selected. 3 parallel lines are inserted, one at the circle --origin and 2 tangent to the circle integer i, IEnd, err, Ents(MaxEnt), NEnts real R, Len1, ArcRad, ArcTrans(15), A1, A2 coord AOrg @ ArcTrans+38, ArcZ @ ArcTrans+26, Dir, PrpPnt, CLEnd1, CLEnd2 boolean warned = false EntMask(0); EntMask(3) --allow only arcs to be picked SetHelp(HelpFile, 1,1,2) --set up getdata help index print 'pick circles ', GetEnt(MaxEnt, NEnts, Ents(1), IEnd) --get circles return when LastChar = Abort or NEnts = 0 loop i = 1 to NEnts RSubrecAC(Ents(i), 1, err, ArcTrans(1), ArcRad, A1, A2) if CoordEq(ArcZ, VwZ) then if CurrentCPL = 0 then AOrg = MapMV(AOrg) --convert origin to view space else AOrg = MapMCPL(AOrg) --convert origin to CPL space End1 = MapMCPL(MapVM(End1)); End2 = MapMCPL(MapVM(End2)) endif Len1 = max(vlen([], AOrg), 1.0) --the following 'if' block sets up the first CLINE through the --circle origin and the Direction to go for the 2 tangent CLINEs if Angle then CLEnd1 = AOrg R = atan2(End2.Y-End1.Y,End2.X-End1.X)+DegRad(AngVal) CLEnd2.X = CLEnd1.X+Len1*cos(R) CLEnd2.Y = CLEnd1.Y+Len1*sin(R) CLEnd2.Z = CLEnd1.Z Dir = coord(sin(R), -cos(R), 0.0) else if Horiz then CLEnd1 = AOrg CLEnd2 = CLEnd1+coord(Len1, 0.0, 0.0) Dir = [0.0,1.0] else if Vert then CLEnd1 = AOrg CLEnd2 = CLEnd1+coord(0.0,Len1,0.0) Dir = [1.0,0.0] else if Prp then Dir = vunit(End2-End1) PntPrp2(End1, End2, AOrg, CLEnd2) CLEnd1 = AOrg else if Prl then PntPrp2(End1, End2, AOrg, PrpPnt) CLEnd1 = AOrg+(End2-End1) CLEnd2 = AOrg Dir = vunit(AOrg-PrpPnt) endif Dir = Dir*coord(ArcRad,ArcRad,0.0) if CurrentCPL <> 0 then Dir = MapMV(MapCPLM(Dir)) CLEnd1 = MapMV(MapCPLM(CLEnd1)) CLEnd2 = MapMV(MapCPLM(CLEnd2)) endif InsCLine(CLEnd1, CLEnd2) --CLINE through the origin InsCLine(CLEnd1+Dir, CLEnd2+Dir) --add first tangent CLINE InsCLine(CLEnd1-Dir, CLEnd2-Dir) --add second tangen CLINE else if not Warned then if CurrentCPL = 0 then WarnMsg('circle not in plane with the current view') else WarnMsg('circle not in plane with the current CPL') endif Warned = true endif endif end loop RpntEnt(Ents(1), NEnts, err) --repaint the hilighted circles picked end proc---------------------------------------------------------------------- proc MakeMidCL---------------------------------------------------------------- --This procedure inserts a contruction line such that it bisects to --lines or construction lines const coord OneHalf = [0.5,0.5,0.5] integer err, IEnd, Ents(MaxEnt), NEnts coord CLEnd1, CLEnd2, End1, End2, MidA1, MidA2, MidB1, MidB2 EntMask(0); EntMask(1); EntMask(15) --allow only lines to be picked loop loop SetHelp(HelpFile, 1,1,3) --set up getdata help index print 'pick 2 lines ', GetEnt(2, NEnts, Ents(1), IEnd) return when LastChar = Abort or LastChar = CR exit when NEnts = 2 if NEnts = 1 then RpntEnt(Ents(1), 1, err) endif return when LastChar = Colon end loop RSubRecXZ(Ents(1), 1, err, MidA1, MidA2) --get the endpoints RSubRecXZ(Ents(2), 1, err, MidB1, MidB2) --check to make sure they are not colinear exit when not CoLinear(MidA1, MidA2, MidB1, MidB2) WarnMsg('colinear lines picked, try again') RpntEnt(Ents(1), NEnts, err) end loop --swap end points around if necassary if vlen(MidA1,MidB1)+vlen(MidA2,MidB2) > \ vlen(MidA1, MidB2)+vlen(MidA2,MidB1) then End1 = MidB1 MidB1 = MidB2 MidB2 = End1 endif if PrlLine(MidA1, MidA2, MidB1, MidB2) then --lines picked were parallel CLEnd1 = (MidA1+MidB1)*OneHalf CLEnd2 = (MidA2+MidB2)*OneHalf else --lines picked were not parallel LinIntOf(MidA1, MidA2, MidB1, MidB2, End1, End2) CLEnd1 = (End1+End2)*OneHalf End1 = MidA2-MidA1 End2 = MidB2-MidB1 --make sure we bisect the smaller angle made by the 2 lines if vlen(End1,-End2) < vlen(End1,End2) then End2 = -End2 endif CLEnd2 = CLEnd1+(End1+End2) endif InsCLine(MapMV(CLEnd1), MapMV(CLEnd2)) RpntEnt(Ents(1), NEnts, err) --repaint the picked hilighted lines end proc---------------------------------------------------------------------- proc MakeEquiDistCL----------------------------------------------------------- --This procedure is used when the EQUIP or DIST modifiers are selected. --It inserts 2 construction lines which are parallel to the lines --selected and a given distance away. The distance is either determined --by the DIST modifier value (which has precedence if selected) or by --using the distance between two parallel lines. integer I, err, IEnd, Ents(MaxEnt), NEnts coord End1, End2, PrpPnt, Dir, LineA1, LineA2, LineB1, LineB2 real R EntMask(0); EntMask(1); EntMask(15) --allow only lines to be picked if not Distance then --the EQUIP modifier was used, so get to parallel lines to use to --setup the DistVal distance loop loop loop SetHelp(HelpFile, 1,1,4) --set up getdata help index print 'pick 2 parallel lines ', GetEnt(2, NEnts, Ents(1), IEnd) return when LastChar = Abort or LastChar = CR exit when NEnts = 2 if NEnts = 1 then RpntEnt(Ents(1), 1, err) endif return when LastChar = Colon end loop RSubRecXZ(Ents(1), 1, err, LineA1, LineA2) RSubRecXZ(Ents(2), 1, err, LineB1, LineB2) --check to make sure the lines picked were parallel exit when PrlLine(LineA1, LineA2, LineB1, LineB2) WarnMsg('lines are not parallel, try again') RpntEnt(Ents(1), NEnts, err) end loop PntPrp2(LineA1, LineA2, LineB1, PrpPnt) R = vlen(LineB1,PrpPnt) RpntEnt(Ents(1), NEnts, err) exit when R > 0.0 WarnMsg('lines are colinear, try again') end loop DistVal = R endif --get lines used to put the CLINES and either side of SetHelp(HelpFile, 1,1,5) --set up getdata help index print 'pick lines ', GetEnt(MaxEnt, NEnts, Ents(1), IEnd) return when LastChar = Abort or NEnts = 0 loop i = 1 to NEnts RSubRecXZ(Ents(i), 1, err, End1, End2) End1 = MapMV(End1); End2 = MapMV(End2) Dir = End2-End1 Dir.Z = 0.0 Dir = vunit(Dir) Dir = coord(Dir.Y*DistVal, -Dir.X*DistVal, 0.0) InsCLine(End1+Dir, End2+Dir) InsCLine(End1-Dir, End2-Dir) end loop RpntEnt(Ents(1), NEnts, err) --repaint the picked hilighted lines end proc---------------------------------------------------------------------- proc MakeDigCL(coord End1, End2)---------------------------------------------- --This procedure puts in construction lines which pass through the given --digitize points and are oriented as determined by the ANGle, HORIZontal, --VERTical, PRP or PRL modifiers. const integer MaxDig = 400 integer i, NDig coord CLEnd1, CLEnd2, DigPnts(MaxDig) real R, Len1 --get locations to put construction lines through SetHelp(HelpFile, 1,1,6) --set up getdata help index print 'dig ', GetDig(MaxDig, 1, NDig, DigPnts(1)) return when LastChar = Abort loop i = 1 to NDig CLEnd1 = MapMV(DigPnts(i)) Len1 = vlen([], CLend1) if Angle then R = atan2(End2.Y-End1.Y,End2.X-End1.X)+DegRad(AngVal) CLEnd2.X = CLEnd1.X+Len1*cos(R) CLEnd2.Y = CLEnd1.Y+Len1*sin(R) CLEnd2.Z = CLEnd1.Z else if Horiz then CLEnd2 = CLEnd1+MapMV(MapCPLM(coord(Len1,0.0,0.0))-MapCPLM([])) else if Vert then CLEnd2 = CLEnd1+MapMV(MapCPLM(coord(0.0,Len1,0.0))-MapCPLM([])) else if Prp then PntPrp2(End1, End2, CLEnd1, CLEnd2) else if Prl then CLEnd2 = CLEnd1+vunit(End2-End1)*coord(Len1, Len1, Len1) endif InsCLine(CLEnd1, CLEnd2) end loop end proc---------------------------------------------------------------------- proc MakePntPntCL------------------------------------------------------------- --This procedure puts in construction lines which pass through the given --pairs of digitize points. const integer MaxDig = 2 integer i, NDig coord CLEnd1, CLEnd2, DigPnts(MaxDig) --get locations to put construction lines through loop SetHelp(HelpFile, 1,1,7) --set up getdata help index print 'dig ', GetDig(MaxDig, 1, NDig, DigPnts(1)) return when LastChar = Abort or NDig <> 2 CLEnd1 = MapMV(DigPnts(1)) CLEnd2 = MapMV(DigPnts(2)) if CoordEq(CLEnd1, CLEnd2) then WarnMsg(' coincident points ') else InsCLine(CLEnd1, CLEnd2) endif exit when LastChar = Colon or LastChar = CR end loop end proc---------------------------------------------------------------------- proc Main--------------------------------------------------------------------- --This is the main procedure to process the UPL 'INSert CLINE' command. integer LinMib, err coord End1 = [], End2 = [] boolean FirstPass = True SysVarI(12, CurrentCPL) --get current CPL number if CurrentCPL = 0 then GetView(0, VwTrans(1)) --get current view orientation else GetCPL(CurrentCPL, VwTrans(1)) --get current CPL orientation endif SetupModifiers --set up the modifer words for this command EntData(2) = 0 --view of visability for inserted construction lines EntData(3) = -1 --construction lines belong to no group when inserted loop --loop to get modifiers exit when LastChar = Abort or LastChar = CR if not FirstPass or LastChar <> Colon then ModifierProcessor --get modifer values from the user exit all when LastChar = Abort or LastChar = CR EndIf FirstPass = False --reset FirstPass flag loop --loop in getdata if Prp or (Prl and (not Distance or Cir)) or Angle then GetLineEnds(LinMib, End1, End2) --get reference line exit all when LastChar = Abort or LastChar = CR exit loop when LastChar = Colon endif if Cir then if Horiz or Vert or Prp or Prl or Angle then MakeCircleCL(End1, End2) else WarnMsg('HORIZ, VERT, PRP, PRL or ANG '+ \ 'must also be picked with CIR') print ':', endif else if Equi or Distance and not Angle then MakeEquiDistCL else if Mid and not Angle then MakeMidCL else if Horiz or Vert or Prp or Prl or Angle then MakeDigCL(End1, End2) else MakePntPntCL endif endif --repaint reference line entity gotten above if Prp or Prl or Angle then RpntEnt(LinMib, 1, err); endif exit all when LastChar = CR or LastChar = Abort --all done exit when LastChar = Colon --go back to modifier processor end loop end loop SetHelp('',1,1,1) --restore default help documentation end proc----------------------------------------------------------------------