home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p115 / 10.ddi / GCD4 / UPL / HIDEINTR.UPL < prev    next >
Encoding:
Text File  |  1988-03-17  |  5.4 KB  |  113 lines
  1. -- 22-Feb-88 NEHolt; Created - UPL 3.0 demo program
  2. --
  3. -- ---------------------------------------  HIDEINTR.UPL  ------------
  4. --  PURPOSE: Hide the intersection of two LINES. The first digitized
  5. --  line remains solid, all LINES digitized after the first will be
  6. --  broken and trimed back at each line's intersection point with the
  7. --  first line. The trim distance is set at 0.0625 inches (db units).
  8.  
  9. --  This program illustrates how to READ an entity's subrecord data.
  10. --  It shows how to create a new entity, WRITE and MODIFY subrecord
  11. --  data, and generate or repaint entity graphics.
  12.  
  13.  PROC MAIN
  14.  
  15.     INTEGER SMib(1),HMib(6000),i,ierr,Ngot,MibData(8),Aray(5)
  16.     INTEGER NewMib
  17.     COORD SCoor(2),HCoor(2),Pnt1,Pnt2
  18.     REAL MainLen,L1,L2,TrimDist,ThisLen
  19.  
  20. -- * * *   start of executable code    * * *
  21.     BREAK_CHAR = 3   -- set up CTRL-C in case of abort (^C=ASCII 003)
  22.     TrimDist=0.0625  -- set TRIM distance
  23.     EntMask(1)  -- only allow LINE entities to be digitized (type=1)
  24.  
  25. --    G E T   M A I N   L I N E
  26.     Print 'Digitize main line (to remain unbroken) :',
  27.     GetEnt(1,Ngot,SMib(1),i);
  28.     if Ngot<>1 then goto NoMore;endif  -- quit if nothing digitized
  29.  
  30.     -- Get endpoints of digitized LINE entity. They are in the LINE's
  31.     -- "XZ" subrecord.
  32.     RSubrecXZ(SMib(1),1,ierr,SCoor(1),SCoor(2))
  33.     if ierr<>0 then goto NoMore;endif  -- quit if some kind of problem
  34.     MainLen=vlen(SCoor(1),SCoor(2))  -- calc length for later use
  35.  
  36. --    G E T   L I N E S   T O   H I D E
  37.     Print;Print 'Digitize lines to hide :',
  38.     GetEnt(6000,Ngot,HMib(1),i);      -- get MIB nums of digitized ents
  39.     if Ngot<1 then goto NoMore;endif  -- quit if none digitized
  40.     --  Process each digitized line.
  41.     loop i=1 to Ngot
  42.       if HMib(i)=SMib(1) then goto DownHere;endif  -- skip main line
  43.       -- Get endpoints of line. Check if intersects with main line
  44.       RSubrecXZ(HMib(i),1,ierr,HCoor(1),HCoor(2))
  45.       if ierr=0 then
  46.         -- Look for intersection point of this line with main line
  47.         LinIntOf(SCoor(1),SCoor(2),HCoor(1),HCoor(2),Pnt1,Pnt2)
  48.         -- reject if no intersection in 3-D space (Pnt1=Pnt2)
  49.         if vlen(Pnt1,Pnt2)<0.01 then
  50.           -- Instersect in 3-D space. Make sure intersection point is
  51.           -- on the first line and not beyond either end of it. Calc
  52.           -- dist from intersection point to either end of main line.
  53.           -- If either distance is greater than line length then
  54.           -- intersection point must lie beyond physical end of line.
  55.  
  56.           if vlen(Pnt1,SCoor(1)) <= MainLen+TrimDist/4.0 then
  57.             if vlen(Pnt1,SCoor(2)) <= MainLen+TrimDist/4.0 then
  58.               -- Make sure intersection point is on the second line
  59.               -- and not beyond either end of it.
  60.               ThisLen=vlen(HCoor(1),HCoor(2))+TrimDist
  61.               if vlen(Pnt1,HCoor(1)) > ThisLen then goto DownHere;endif
  62.               if vlen(Pnt1,HCoor(2)) > ThisLen then goto DownHere;endif
  63.               --  They do intersect, okay to continue.
  64.               --  B R E A K   T H I S   L I N E
  65.               -- Determine length of each segment of broken line.
  66.               L1=vlen(HCoor(1),Pnt1)
  67.               L2=vlen(HCoor(2),Pnt1)
  68.               --  M O D I F Y   F I R S T   S E G M E N T
  69.               -- Shorten existing line. Adjust one of its end points.
  70.               -- This will be one segment of the broken line.
  71.               if L1 > TrimDist then
  72.                 -- Calculate new end point of the line.
  73.                 Pnt2.x=HCoor(1).x+((L1-TrimDist)/L1)*(Pnt1.x-HCoor(1).x)
  74.                 Pnt2.y=HCoor(1).y+((L1-TrimDist)/L1)*(Pnt1.y-HCoor(1).y)
  75.                 Pnt2.z=HCoor(1).z+((L1-TrimDist)/L1)*(Pnt1.z-HCoor(1).z)
  76.                 -- Modify line's XZ subrecord with new end point coors
  77.                 MSubrecXZ(HMib(i),1,ierr,HCoor(1),Pnt2)
  78.               else
  79.                 Erase Ent_Id(HMib(i))  -- too short, delete it.
  80.               endif
  81.  
  82.               --  C R E A T E   N E W   S E G M E N T
  83.               if L2 > TrimDist then
  84.                 -- Create new LINE ent. First get COL/FONT/LAY of original.
  85.                 ReadEnt(HMib(i),MibData(1))  -- get 8 word index block
  86.                 -- Set up array to create new entity MIB index block
  87.                 Aray(1)=MibData(4) -- LAYER in 4th word
  88.                 Aray(2)=MibData(5) -- VIEW VIS in 5th word
  89.                 Aray(3)=MibData(6) -- GROUP NUMBER in 6th word
  90.                 Aray(4)=MibData(7) -- FONT in 7th word
  91.                 Aray(5)=MibData(8) -- COLOR in 8th word
  92.                 -- Create new LINE entity (type=1)
  93.                 Addent(1,Aray(1),NewMib,ierr) -- create MIB index block
  94.                 -- Add XZ line end point subrecord to new LINE entity.
  95.                 -- Calc beginning point of line and use original end pnt.
  96.                 Pnt2.x=HCoor(2).x+((L2-TrimDist)/L2)*(Pnt1.x-HCoor(2).x)
  97.                 Pnt2.y=HCoor(2).y+((L2-TrimDist)/L2)*(Pnt1.y-HCoor(2).y)
  98.                 Pnt2.z=HCoor(2).z+((L2-TrimDist)/L2)*(Pnt1.z-HCoor(2).z)
  99.                 WSubrecXZ(NewMib,ierr,Pnt2,HCoor(2)) -- add "XZ" subrecord
  100.                 -- Generate graphics for the new LINE entity
  101.                 RpntEnt(NewMib,1,ierr);
  102.               endif
  103.               RpntEnt(HMib(i),1,ierr); -- Repaint the original LINE
  104.             endif
  105.           endif
  106.         endif
  107.       endif
  108. DownHere:
  109.     end_loop
  110. NoMore:
  111.  end proc
  112.  
  113.