MiniPascal Supplement

DeriveArcBBox

Procedure DeriveArcBBox(CenterX,CenterY,Rad:REAL; VAR X1,Y1,X2,Y2:REAL);
BEGIN
	X1:=CenterX-Rad;
	Y1:=CenterY+Rad;
	X2:=CenterX+Rad;
	Y2:=CenterY-Rad;
END;

What it does
Returns the bounding box coordinates of an arc or circle when given it's center and radius. The coordinates can then be used elsewhere in the macro.

DeriveOvalBBox

Procedure DeriveOvalBBox(CenX,CenY,HorAx,VerAx:REAL; VAR X1,Y1,X2,Y2:REAL);
BEGIN
	X1:=CenX-HorAx;
	Y1:=CenY+VerAx;
	X2:=CenX+HorAx;
	Y2:=CenY-VerAx;
END;

What it does
Returns the bounding box coordinatess of an oval given the oval center and dimensions of the horizontal and vertical axes of the oval.

CircleByCtrRad

Procedure CircleByCtrRad(CenX,CenY,Rad:REAL);
VAR
	X1,Y1,X2,Y2:REAL;
BEGIN
	X1:=CenX-Rad;
	Y1:=CenY+Rad;
	X2:=CenX+Rad;
	Y2:=CenY-Rad;
	Oval(X1,Y1,X2,Y2);
END;

What it does
Creates a circle when given center and radius information.

ArcByCtrRad

Procedure ArcByCtrRad(CenX,CenY,Rad,StartAngle,SweepAngle:REAL);
VAR
	X1,Y1,X2,Y2:REAL;
BEGIN
	X1:=CenX-Rad;
	Y1:=CenY+Rad;
	X2:=CenX+Rad;
	Y2:=CenY-Rad;
	Arc(X1,Y1,X2,Y2,StartAngle,SweepAngle);
END;

What it does
Creates an arc when given a center and radius.

ArcPoints

Procedure ArcPoints(ArcHd:HANDLE;VAR StartX,StartY,EndX,EndY:REAL);
VAR
	StartAngle,ArcAngle,SweepAngle,R,CenX,CenY:REAL;
BEGIN
	GetArc(ArcHd,StartAngle,ArcAngle);

	R:=(HPerim(ArcHd)/(Deg2Rad(ArcAngle)))*12;
	HCenter(ArcHd,CenX,CenY);

	StartX:=CenX+(R*(cos(Deg2Rad(StartAngle))));
	StartY:=CenY+(R*(sin(Deg2Rad(StartAngle))));

	SweepAngle:=ArcAngle+StartAngle;
	EndX:=CenX+(R*(cos(Deg2Rad(SweepAngle))));
	EndY:=CenY+(R*(sin(Deg2Rad(SweepAngle))));
END;

What it does
Calculates and returns coordinates of the start point and end point of an arc. You must supply handle to an arc object.

ArcRadius

Function ArcRadius(ArcHd:HANDLE):REAL;
VAR
	AAng,Rad:REAL;
BEGIN
	AAng:=HAngle(ArcHd);
	Rad:=(HPerim(ArcHd)*12/Deg2Rad(AAng));
	ArcRadius:=Rad;
END;

What it does
Returns the radius of an arc. You must supply handle to an arc object.

ObjectInfo

Procedure ObjectInfo(ObjectHd:HANDLE;VAR LayerN,ClassN,NameN:STRING;VAR Type,FillPatNum,LStyleNum,LWt :INTEGER);
VAR
	LayerHd:HANDLE;
BEGIN
	LayerHd:=GetLayer(ObjectHd);
	LayerN:=GetLName(LayerHd);
	
	ClassN:=GetClass(ObjectHd);
	NameN:=GetName(ObjectHd);
	
	Type:=GetType(ObjectHd);
	FillPatNum:=GetFPat(ObjectHd);
	LStyleNum:=GetLS(ObjectHd);
	LWt:=GetLW(ObjectHd);
END;

What it does
Returns attribute data on the object passed to it by handle. Returns layer, class, name, fill pattern, linestyle, and lineweight data.

ObjectGeom2D

Procedure ObjectGeom2D(ObjectHd: HANDLE;VAR BBoxX1,BBoxY1,BBoxX2,BBoxY2,Ht,Width,Area,Perim:REAL);
BEGIN
	GetBBox(ObjectHd,BBoxX1,BBoxY1,BBoxX2,BBoxY2);
	Ht:=HHeight(ObjectHd);
	Width:=HWidth(ObjectHd);
	Area:=HArea(ObjectHd);
	Perim:=HPerim(ObjectHd);
END;

What it does
Returns geometric data on the 2D object passed to it by handle. Returns bounding box, height, width, area, and perimeter data.

ObjectGeom3D

Procedure ObjectGeom3D(ObjectHd: HANDLE;VAR Ht,Width,Depth,CenX,CenY,CenZ:REAL);
BEGIN
	Get3DInfo(ObjectHd,Ht,Width,Depth);
	Get3DCnter(ObjectHd,CenX,CenY,CenZ);
END;

What it does
Returns geometric data on the 3D object passed to it by handle. Returns height, width, depth, and 3D center data.

TextInfo

Procedure TextInfo(ObjectHd:HANDLE;VAR ContentStr:STRING;FontID,Size,StyleSum:INTEGER);
BEGIN
	ContentStr:=GetText(ObjectHd);
	FontID:=GetFont(ObjectHd);
	Size:=GetSize(ObjectHd);
	StyleSum:=GetStyle(ObjectHd);
END;

What it does
Returns attribute data on the text object passed to it by handle. Returns text string, font ID number, size, and style information.

StyleReader

Procedure StyleReader(StyleIndex:INTEGER;VAR IsPlain,IsBold,IsItal,IsUnd,IsOutL,IsShad:BOOLEAN);
VAR
	StyleArray:ARRAY [1..6] OF BOOLEAN;
	i,FlagCompare:INTEGER;
BEGIN
	i:=1;
	FlagCompare:=16;
	
	StyleArray[1]:=FALSE;
	StyleArray[2]:=FALSE;
	StyleArray[3]:=FALSE;
	StyleArray[4]:=FALSE;
	StyleArray[5]:=FALSE;
	IsPlain:=FALSE;

	
	WHILE StyleIndex > 0 DO BEGIN
		IF StyleIndex >= FlagCompare THEN BEGIN
			StyleIndex:=StyleIndex-FlagCompare;
			StyleArray[i]:=TRUE;
		END;
		
		i:=i+1;
		FlagCompare:=FlagCompare DIV 2;
		IF (FlagCompare = 0) THEN FlagCompare:=1;
	END;
	
	IsShad:=StyleArray[1];
	IsOutL:=StyleArray[2];
	IsUnd:=StyleArray[3];
	IsItal:=StyleArray[4];
	IsBold:=StyleArray[5];
	
	IF NOT (IsShad)&(NOT IsOutL)&(NOT IsUnd)&(NOT IsItal)&(NOT IsBold) THEN
		IsPlain:=TRUE;
END;

What it does
Returns text style as BOOLEAN values. Makes it easier to determine style returned by TextInfo() above, or by MiniPascal's GetStyle procedure.

TraverseWall

Function TraverseWall(WallHd:HANDLE;SymbolName:STRING;SelectStat:BOOLEAN):HANDLE;
VAR
	Hd:HANDLE;
	Type:INTEGER;
	Nm:STRING;
	Sel,Hit:BOOLEAN;
BEGIN
	Hd:=FIn3D(WallHd);
	WHILE (Hd<>NIL) AND (NOT Hit) DO BEGIN
		Type:=GetType(Hd);
		IF Type=15 THEN BEGIN
			SelectStat:=Selected(Hd);
			Nm:=GetSymName(Hd);
			
			IF ((Nm=SymbolName)AND(SelectStat=Sel)) THEN Hit:=TRUE;
		END
		ELSE BEGIN
			Hd:=NextObj(Hd);
		END;
	END;
	
	TraverseWall:=Hd;
END;

What it does
Enters a wall object and searches for the specified symbol; when found, it returns the handle to the symbol. You have the option of specifying whether the symbol is selected; if not, the first symbol which matches the specification will be returned.

Subroutine Notes
(1) You will need to check for NIL being returned(indicates no symbol was found).

TraverseWallName

Function TraverseWallName(WallHd:HANDLE):STRING;
VAR
	Hd:HANDLE;
	Type:INTEGER;
	Nm:STRING;
	Sel,Hit:BOOLEAN;
BEGIN
	Hit:=FALSE;
	Hd:=FIn3D(WallHd);
	WHILE (Hd<>NIL) AND (NOT Hit) DO BEGIN
		Type:=GetType(Hd);
		IF Type=15 THEN BEGIN			
			IF (Selected(Hd)) THEN Hit:=TRUE;
		END
		ELSE BEGIN
			Hd:=NextObj(Hd);
		END;
	END;
	
	TraverseWallName:=GetSymName(Hd);
END;

What it does
Enters a wall object and searches for the selected symbol; when found, it returns the name of the symbol.

MakeModelLink

Procedure MakeModelLink(LayerName,LinkName:STRING);
BEGIN
	IF LinkName='NIL' THEN BEGIN
		LinkName:=Concat(LayerName,' Link');
	END;
	LayerRef(LayerName);
	ResetOrientation3D;
	UnLckObjs;
	SetName(LNewObj,LinkName);
	LckObjs;
END;

What it does
Creates a named layer reference(layer link) on the active layer of the document. Lock status of the link is preserved. If LinkName is specified as 'NIL' string, the ref name will be constructed from the source layer's name. For example, MakeModelLink('Layer-1','NIL'); will create a layer link named 'Layer-1 Link'.

SwapLink

Procedure SwapLink(LinkName:STRING;NewLayer:STRING);
VAR
	oldLinkHd,newLinkHd,LHd:HANDLE;
	name:STRING;
	Found:BOOLEAN;
BEGIN
	oldLinkHd:=GetObject(LinkName);
	Found:=False;
	LHd:=FLayer;
	newLinkHd:=NIL;

	WHILE (LHd<> NIL) & (NOT Found) DO BEGIN
		name:=GetLName(LHd);
		IF name=NewLayer THEN BEGIN
			Found:=True;
			newLinkHd:=LHd;
		END;
		LHd:=NextLayer(LHd);
	END;

	IF newLinkHd <> NIL THEN BEGIN
		SetHDef(oldLinkHd,newLinkHd);
		ResetOrientation3D;
		Redraw;
	END
	ELSE BEGIN
		AlrtDialog('Warning: new link was not found');
	END;
END;

What it does
Updates the layer reference model specified by LinkName with a reference to the layer specified. elevation of the model link is unaffected.

Subroutine Notes
(1) You can use this routine to create 'before and after' models by swapping layer links. (2) This subroutine works with MiniCAD 6.0 or greater.

MoveSymInWall

Procedure MoveSymInWall(h:HANDLE;dist:REAL);
VAR
	sh:HANDLE;
	x1,y1,x2,y2,d:REAL;
	symName:STRING;

Function TraverseWallSel(WallHd:HANDLE):HANDLE;
VAR
	Hd:HANDLE;
	Type:INTEGER;
	Sel,Hit:BOOLEAN;
BEGIN
	Hit:=FALSE;
	Hd:=FIn3D(WallHd);
	
	WHILE (Hd<>NIL) AND (NOT Hit) DO BEGIN
		Type:=GetType(Hd);
		
		IF Type=15 THEN BEGIN			
			IF (Selected(Hd)) THEN Hit:=TRUE
		ELSE
			Hd:=NextObj(Hd);	
		END
		ELSE BEGIN
			Hd:=NextObj(Hd);
		END;
	END;
	
	TraverseWallSel:=Hd;
END;

BEGIN
	IF(GetType(h) = 68) THEN BEGIN
		GetSegPt1(h,x1,y1);
		sh:=TraverseWallSel(h);
		IF sh <> NIL THEN BEGIN
			GetSymLoc(sh,x2,y2);
			symName:=GetSymName(sh);
	
			d:=Distance(x1,y1,x2,y2);
			d:=d+dist;
	
			IF DeleteWallSym(sh) THEN
				AddSymToWall(h,d,0,FALSE,FALSE,symName);
		END;
	END;		
END;

What it does
Moves the selected symbol in a wall the distance specified by you.

SetCustomLightColor

Procedure SetCustomLightColor(hd:HANDLE;rpercent,gpercent,bpercent:INTEGER);
VAR
	red,grn,blu:LONGINT;

FUNCTION PercentToRGB(percentage:INTEGER):LONGINT;
CONST 
	MAX_RGB = 65535;
VAR
	calcRGB:LONGINT;
BEGIN
	calcRGB:= Trunc((MAX_RGB * (percentage/100)));
	Percent2RGB := calcRGB;
END;
	
BEGIN
	red:=PercentToRGB(rpercent);
	grn:=PercentToRGB(gpercent);
	blu:=PercentToRGB(gpercent);
	
	SetPenFore(hd,red,grn,blu);
END;

What it does
Sets a custom color for the specified light.

[Home][Previous][Next]