Jump to content

paulvector2

Member
  • Posts

    27
  • Joined

  • Last visited

Posts posted by paulvector2

  1. I made a small workaround for this problem. I placed the script in the object context menue, so its always present. The function is limited to single dimensions, maybe some solutions for chain dimensions here in the forum. so here comes my script for setting the elevation in SIA dim.

    { ////
    
    Set Dim Elevation
    (c) B. Schambeck. Distribute Freely.
    
    //// }
    
    PROCEDURE DimElevation;
    VAR
    H1 : HANDLE;
    dialogOK,ShElev, CusElev : BOOLEAN;
    dialog1,sx,x : INTEGER;
    elev,y : REAL;
    lead,trail : STRING;
    
    { ////
    
    Dialog Handler
    
    //// }
    
    PROCEDURE Dialog_Handler(VAR item:LONGINT; data:LONGINT);
    BEGIN
    CASE item OF
    	SetupDialogC:BEGIN
    		SetBooleanItem(dialog1,4,TRUE);
    		SetBooleanItem(dialog1,5,TRUE);
    		H1:= FSActLayer;
    		x:= GetPrefInt(170);
    		IF (x = 8) THEN BEGIN
    		sx := 10;
    		END;
    		IF (x = 9) THEN BEGIN
    		sx := 1000;
    		END;
    		y:=GetObjectVariableReal(H1,47);
    		SetEditReal(dialog1, 7, 3, y/sx);
    	END;
    
    	1:BEGIN
    		{ get settings }
    		GetBooleanItem(dialog1, 4, ShElev);
    		GetBooleanItem(dialog1, 5, CusElev);
    		dialogOK := GetEditReal(dialog1, 7, 3, elev);
    		GetItemText(dialog1, 9, lead);
    		GetItemText(dialog1, 11, trail);
    	END;
    
    END;
    END;
    
    { ////
    
    Dialog Creation
    
    //// }
    
    BEGIN
    
    dialog1 := CreateLayout('Dim Elevation',FALSE,'OK','Cancel');
    
    CreateCheckBox(dialog1,4,'Show Elevation');
    CreateCheckBox(dialog1,5,'Custom Elevation');  
    CreateStaticText(dialog1,6,'Elevation:',-1);
    CreateEditReal(dialog1,7,3,0,26);
    CreateStaticText(dialog1,8,'Leader:',-1);
    CreateEditText(dialog1,9,'',26);
    CreateStaticText(dialog1,10,'Trailer:',-1);
    CreateEditText(dialog1,11,'',26);
    
    SetFirstLayoutItem(dialog1, 4);
    SetBelowItem (dialog1,4,5,0,0);
    SetBelowItem (dialog1,5,6,0,0);
    SetRightItem (dialog1,6,7,0,0);
    SetBelowItem (dialog1,6,8,0,0);
    SetRightItem (dialog1,8,9,0,0);
    SetBelowItem (dialog1,8,10,0,0);
    SetRightItem (dialog1,10,11,0,0);
    
    AlignItemEdge (dialog1,6,1,1010,1);
    AlignItemEdge (dialog1,8,1,1010,1);
    AlignItemEdge (dialog1,10,1,1010,1);
    
    AlignItemEdge (dialog1,7,3,1010,1);
    AlignItemEdge (dialog1,9,3,1010,1);
    AlignItemEdge (dialog1,11,3,1010,1); 
    
    
    
    IF VerifyLayout(dialog1) THEN BEGIN
    	IF RunLayoutDialog(dialog1, Dialog_Handler) = 1 THEN BEGIN
    		x:= GetPrefInt(170);
    		IF (x = 8) THEN BEGIN
    		sx := 10;
    		END;
    		IF (x = 9) THEN BEGIN
    		sx := 1000;
    		END;
    
    		H1:= FSActLayer;
    		SetObjectVariableBoolean(H1,46,ShElev);
    		SetObjectVariableBoolean(H1,1249,CusElev);
    		SetObjectVariableReal(H1,47,elev*sx);
    		SetObjectVariableString(H1,48,lead);
    		SetObjectVariableString(H1,49,trail);
    ResetObject(H1);
    
    	END;
    END;
    
    END;
    
    Run(DimElevation);

  2. Dear Maarten,

    thank you for your quick reply. There are a few little faults.

    "FOR laycnt:=1 TO NumLayers DO" should be

    "FOR laycnt:=0 TO NumLayers DO".

    But the other fault, i have no idea. The script give always the total quantity of symbols from the first layer in list (regardless if the layer is selected or not) to the last selected layer. any ideas?

    Paul

  3. Ok here is the script.

    {Maarten Vandickelen and others 2008}
    PROCEDURE Layerlist;
    VAR
    winH : DYNARRAY of HANDLE;
    WinL : DYNARRAY of REAL;
    WinN : DYNARRAY of STRING;
    WinQ : DYNARRAY of LONGINT;
    DynWahlLayer : DYNARRAY OF STRING;
    total : INTEGER;
    count, counter : INTEGER;
    tmpS,sytext,gName,vargName : STRING;
    tmpCount, posSel, position : INTEGER;
    cnt1,cnt2 : INTEGER;
    tmpR : REAL;
    tmpH, Latemp : HANDLE;
    tmpL : LONGINT;
    pt1,pt2 : POINT;
    ptN1,ptN2 : POINT;
    id : LONGINT;
    Layerliste : INTEGER;
    varLName, WahlLayer : STRING;
    
    {--------------------------------------------------------------------------------------------------}
    
    PROCEDURE Dialog;
    VAR
    id : INTEGER;
    Dialogresult : INTEGER;
    
    		PROCEDURE Define_NameDialog;
    		BEGIN
    		id := CreateResizableLayout('List',TRUE,'OK','Cancel',TRUE,TRUE);
    			{ define the controls for the dialog }
    		CreateStaticText(id,4,'Symbolname contains:',-1);
    		CreateEditText(id,5,'window',26);
    
    		CreateStaticText(id,6,'Select Layers',-1);
    		CreateListBoxN(id,7,33,13,True);
    
    		{ perform the dialog layout }
    		SetFirstLayoutItem(id,4);
    		SetRightItem(id,4,5,0,0);
    		SetBelowItem(id,5,6,0,0);
    		SetBelowItem(id,6,7,0,0);
    
    		{ perform final control alignment and adjustment
    		AlignItemEdge(id,4,1,1001,0);
    
    		SetEdgeBinding (id,6,FALSE,FALSE,TRUE,FALSE);
    		SetEdgeBinding (id,7,TRUE,TRUE,TRUE,TRUE);
    
    		{ create help text for controls }
    		SetHelpString(1,'List');
    		SetHelpString(2,'Cancel the operation and exit.');
    		SetHelpString(4,'Symbolname contains string.');
    		SetHelpString(5,'Symbolname contains string.');
    		SetHelpString(7,'STRG + click');
    		END;
    
    {--------------------------------------------------------------------------------------------------}
    
    		PROCEDURE Drive_NameDialog (Var item,data : LONGINT);
    			PROCEDURE Dialogsettings;
    				PROCEDURE Layerlistfilling(Layerliste:INTEGER);
    				VAR
    				I : INTEGER;
    				LayerName  : STRING;
    				LayerHand : HANDLE;
    				id : LONGINT;
    				LayerZahl : DYNARRAY OF STRING;
    
    				BEGIN
    
    				ALLOCATE Layerzahl[1..NumLayers];
    				LayerHand := FLayer;
    				I := 1;
    
    				LayerZahl[i] := GetLName(layerHand);
    				REPEAT
    						LayerHand := NextObj(LayerHand);
    						I := I+1;
    						LayerZahl[i] := GetLName(layerHand);
    				UNTIL I = NumLayers;
    
    				SortArray(LayerZahl,NumLayers,1);
    				FOR I := 1 TO NumLayers DO InsertChoice(7,NumChoices(7),LayerZahl[i]);
    
    			END;
    
    		BEGIN
    			Layerlistfilling(Layerliste);
    		END;
    
    {--------------------------------------------------------------------------------------------------}
    
    		PROCEDURE SetInfo(h : HANDLE);
    			VAR
    			cnt : INTEGER;
    				bool : BOOLEAN;
    			BEGIN
    				IF total>0 THEN FOR cnt:=1 TO total DO IF GetSymName(h)=WinN[cnt] THEN
    				BEGIN
    					bool:=TRUE;
    					WinQ[cnt]:=WinQ[cnt]+1;
    				END;
    				IF NOT bool THEN
    				BEGIN
    					total:=total+1;
    					ALLOCATE winH[1..total];
    					ALLOCATE winL[1..total];
    					ALLOCATE winN[1..total];
    					ALLOCATE winQ[1..total];
    
    					winH[total]:=h;
    					GetBBox(h,pt1.x,pt1.y,pt2.x,pt2.y);
    					WinL[total]:=pt2.x-pt1.x;
    					WinN[total]:=GetSymName(h);
    					WinQ[total]:=1;
    
    				END;
    			END;
    
    {--------------------------------------------------------------------------------------------------}
    
    PROCEDURE HANDLEOK;
    BEGIN
    
    
    ALLOCATE DynWahlLayer[0..NumLayers];
    counter := 0;
    posSel := 0;
    
    GetSelChoice(7,posSel,position,WahlLayer);
    DynWahlLayer[counter] := WahlLayer;
    REPEAT
    counter := counter+1;
    posSel := posSel+1;
    GetSelChoice(7,posSel,position,WahlLayer);
    DynWahlLayer[counter] := WahlLayer;
    UNTIL (zaehler>position);
    
    	gName := GetField(5);
    
    	vargName:=concat('(','S=',CHR(39),'*',gName,'*',CHR(39),') & (L IN [',DynWahlLayer[zaehler],'])');
    
    
    ForEachObject(SetInfo,vargName);
    IF total<>0 THEN
    BEGIN
    {create new layer}
    	tmpS:='New_Layer';
    	IF GetObject(tmpS)<>NIL THEN
    	BEGIN
    		REPEAT
    			tmpCount:=tmpCount+1;
    			IF GetObject(ConCat(tmpS,Num2Str(0,tmpCount)))=NIL THEN tmpS:=ConCat(tmpS,Num2Str(0,tmpCount));
    		UNTIL(GetObject(tmpS)=NIL);
    	END;
    	Layer(tmpS);
    	SetLScale(ActLayer, 50);
    	DoMenuTextByName('Standard Views',1);
    
    
    
    {sort symbols by length}
    	FOR cnt1:=1 TO total DO
    	BEGIN
    		FOR cnt2:=1 TO total-cnt1 DO
    		BEGIN
    			IF WinL[cnt2]>WinL[cnt2+1] THEN
    			BEGIN
    				tmpH:=WinH[cnt2];
    				tmpR:=WinL[cnt2];
    				tmpS:=WinN[cnt2];
    				WinH[cnt2]:=WinH[cnt2+1];
    				WinL[cnt2]:=WinL[cnt2+1];
    				WinN[cnt2]:=WinN[cnt2+1];
    				WinH[cnt2+1]:=tmpH;
    				WinL[cnt2+1]:=tmpR;
    				WinN[cnt2+1]:=tmpS;
    			END;
    		END;
    	END;
    {place symbol}
    	FOR count:=1 TO total DO
    	BEGIN
    		IF count=1 THEN BEGIN
    			Symbol(winN[count],0,0,0);
    			GetBBox(LNewObj,pt1.x,pt1.y,pt2.x,pt2.y);
    			MoveTo(0,pt2.y-20cm);
    			CreateText(Concat(Num2Str(0,WinQ[count]),' St?ck ',CHR(13),WinN[count]));
    			SetTextJust(LNewObj,1);
    		END ELSE
    		BEGIN
    			GetBBox(LNewObj,pt1.x,pt1.y,pt2.x,pt2.y);
    			Symbol(WinN[count],0,0,0);
    			GetBBox(LNewObj,ptN1.x,ptN1.y,ptN2.x,ptN2.y);
    		{move this symbol 100cm over the last symbol}
    			HMove(LNewObj,pt2.x-ptN1.x+100cm,0);
    		{write the quantity and name under the symbol}
    			MoveTo(pt2.x-ptN1.x+100cm,ptN2.y-20 cm);
    			CreateText(Concat(Num2Str(0,WinQ[count]),' St?ck ',CHR(13),WinN[count]));
    			SetTextJust(LNewObj,1);
    		END;
    
    	END;
    
    DoMenuTextByName('Standard Views',3);
    SetLayerRenderMode(ActLayer,6,true,false);
    END;
    END;
    
    {--------------------------------------------------------------------------------------------------}
    
    PROCEDURE HANDLEBAD;
    BEGIN
    END;
    
    BEGIN
    	CASE item OF
    	SetupDialogC: Dialogsettings;
    	1 : HANDLEOK;
    	2 : HANDLEBAD;
    END;
    END;
    
    
    BEGIN
    Define_NameDialog;
    IF VerifyLayout(id) THEN
    Dialogresult:=RunLayoutDialog(id,Drive_NameDialog);
    END;
    
    BEGIN
    Dialog;
    END;
    
    RUN(Layerlist);

  4. Dear maarten,

    i used now a listbox. the listbox will be filled with the layers.

    but how can i now give the selected layers to my searchstring?

    PROCEDURE HANDLEOK;
    BEGIN
    
        ALLOCATE DynWahlLayer[0..posSel+1];
    counter := 0;
    posSel := 0;
    
    GetSelChoice(7,posSel,position,WahlLayer);
    DynWahlLayer[counter] := WahlLayer;
    REPEAT
    counter := counter+1;
    posSel := posSel+1;
    GetSelChoice(7,posSel,position,WahlLayer);
    DynWahlLayer[counter] := WahlLayer;
    UNTIL (counter>position);
    
    	gName := GetField(5);
    
    	vargName:=concat('(','S=',CHR(39),'*',gName,'*',CHR(39),') & (L IN [',DynWahlLayer[counter],'])');
    
    
    ForEachObject(SetInfo,vargName);
    

  5. Hello Pat, Hello Maarten.

    Your script works fine, so far. I added a dialog to enter a searchstring for the symbolnames in the drawing. Also this works fine. Now i wanted to add a browerList to limit the search only on layers, which i check. But this i can not make working. May you have an idea.

    Paul

  6. Dear Pat,

    I'm trying to make a new drawing (layer), which contains all my symbols (in this case windows) placed in the drawing. My windowsymols are hybrid. So I make a new Layer, switch to 3D View 'front', search for all symbols, placed in the other layers of the Drawing, containing the substring 'window' and place them in the new Layer, labeled with name and quantity. All this with a script.

  7. Here is the code:

    PROCEDURE Space; { ? Petri Sakkinen 2002 }

    CONST

    kObjOnInitXProperties = 5;

    kResetEventID = 3;

    kObjXPropSpecialEdit = 3;

    kDefaultSpecialEdit = 0;

    kCustomSpecialEdit = 1;

    kPropertiesSpecialEdit = 2;

    kReshapeSpecialEdit = 3;

    kObjXIs2DSurfaceEligible = 14;

    VAR

    theEvent, theButton :LONGINT;

    fID : INTEGER;

    result :BOOLEAN;

    objHand, recHand, wallHand, pathHand, dupeHand :HANDLE;

    objName, spaceArea, spacePerim, spaceGroup, labelText, font :STRING;

    x, y, x1, y1, x2, y2, rotA, tagA : REAL;

    PROCEDURE MakeTag;

    BEGIN

    IF PTAGSPACENO THEN labelText:=CONCAT(PSPACENO, ' ', CHR(13));

    IF PTAGSPACENAME THEN labelText:=CONCAT(labelText, PSPACENAME, CHR(13))

    ELSE labelText:=CONCAT(labelText, CHR(13));

    IF PTAGSPACEAREA THEN labelText:=CONCAT(labelText, 'A: ', spaceArea, ' m? ', CHR(13));

    IF PTAGSPACEPERIM THEN labelText:=CONCAT(labelText, 'U: ', spacePerim, ' m ', CHR(13));

    IF PTAGGROUP THEN labelText:=CONCAT(labelText, spaceGroup, CHR(13));

    IF PTAGLAYER THEN labelText:=CONCAT(labelText, GETLNAME(GETLAYER(dupeHand)));

    x:=PCONTROLPOINT01X;

    y:=PCONTROLPOINT01Y;

    tagA:= PTAGANGLE;

    rotA:=GETSYMROT(dupeHand);

    font:=PFONT;

    IF NOT(font='Default') THEN BEGIN

    fID:=GETFONTID(font);

    TEXTFONT(fID);

    END;

    TEXTROTATE(tagA-rotA);

    NAMECLASS('TAGS');

    TEXTJUST(1);

    TEXTVERTICALALIGN(1);

    TEXTSIZE(PTEXTSIZE);

    FILLPAT(0);

    TEXTORIGIN(x, y);

    CREATETEXT(labelText);

    END;

    BEGIN

    vsoGetEventInfo(theEvent, theButton);

    CASE theEvent OF

    {User has single-clicked the object's icon.}

    kObjOnInitXProperties:

    BEGIN

    {This defines the double-click behavior to active the 2D Reshape tool.}

    result := SetObjPropCharVS(kObjXPropSpecialEdit, Chr(kReshapeSpecialEdit));

    result := SetObjPropVS(kObjXIs2DSurfaceEligible, TRUE);

    END;

    {Object reset has been called.}

    kResetEventID:

    BEGIN

    IF GetCustomObjectInfo(objName, objHand, recHand, wallHand) THEN BEGIN

    pathHand := GetCustomObjectPath(objHand);

    dupeHand := CreateDuplicateObject(pathHand, objHand);

    spaceArea:=NUM2STR(2, HAREA(dupeHand)/10000);

    spacePerim:=NUM2STR(2, HPERIM(dupeHand)/100);

    MakeTag;

    END;

    END;

    END;

    END;

    Run(Space);

×
×
  • Create New...