XProfan

- Page 3 -

Web
Scanner

Hi Georg,

for Leiterplatten in small series there still really preiswerte suppliers,
or be I there wrong informed?

The Fräserei of Leiterplatten rewards itself (probably) for series sooner not,
there the Isolationsfräsen still right long lasts and quite
Fräserverschleissend (with FR4) is. the same thing counts too for Bohrer.
with Ebay Gibts then always The aussortierten Fräser ud Bohrer, The yet for wood and
plastic spicy enough are.

for single pattern can it again properly his, there one not whom whole
lane the making over the Ätzen weg must.

the bore is naturally with a CNC one Klacks, as long as the Boher holds.
rather would it (if possible) itself on a mittleren Bohr Durchmesser festzulegen.
The Umspannerei isn't straight popular, and one must not so many different
Bohrergrößen vorhalten.

Regards

Web

Xprofan X3.1

Win7 auf AMDX6

07/05/08 ▲

GDL

Hi,

have it almost already befürchtet.Platinendienst is To valuable.need ca. 300 Platinen with untershiedlichem Layout.
with the Ätztechnik can I Yes yet life.for the bore must I me hold what consider.

Hello
Georg

Edit: The Bohrergrößen are Bauteile conditioned.

Windows7 Xprofan 8,9,10 [...]

[...]

07/06/08 ▲

Web
Scanner

Hi Georg,

know You The Tanbo of Elektor?

= Tangential - Bohr - machine

the would ev. what to that Leiterplattenbohren ?
i know though not what the thing cost. Ev. Selbstbau possible?
as the unit new was, found I the concept very interestingly.

[...]

Regards

Web

Xprofan X3.1

Win7 auf AMDX6

07/07/08 ▲

RGH

Web Scanner

@Roland, have You possible already what in Your archive found?

Web

give me Please yet something Time until weekend!

Greeting
Roland

Hi,
I'm sorry, but evident have I the erwähnten Source not any more.
there the HPGL-stature but one reines ASCII-stature is, ought to it in XProfan not too heavy his, one Program To write, that The File einliest and on-screen darstellt.
Greeting
Roland

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

07/07/08 ▲

Web
Scanner

Hello Roland,

no trouble,
many Thanks for Search.

I were time yet ex, what IF intends moreover To proggen,
otherwise lay I first go and will be further ask having

Regards

Web

Xprofan X3.1

Win7 auf AMDX6

07/07/08 ▲

@Georg: look time [...]

of Member [...]

- vlt. ensteht there something?

@WebS: a Loadergrundstock can I for gladly today evening (home) aufbereiten and here post.

07/10/08 ▲

functions

Orignalsource in the pkg, here The enh:
Compile Mark Separation

SET(errorLevel,-1)

proc LASTSUBSTR

    PARAMETERS S$,D$
    RETURN (SUBSTR$(S$,LEN(S$,D$),D$))

endproc

proc NOTLASTSUBSTR

    PARAMETERS S$,D$
    RETURN DEL$(S$,LEN(S$,D$),1,D$)

endproc

proc NOTFIRSTSUBSTR

    PARAMETERS S$,D$
    RETURN DEL$(S$,1,1,D$)

endproc

proc SETSUBSTR

    PARAMETERS S$,N&,D$,NS$
    RETURN INS$(NS$,DEL$(S$,N&,1,D$),N&,D$)

endproc

proc FTOA

    PARAMETERS F!
    RETURN +SUBSTR$(STR$(F!),1,.)

endproc

proc STRI

    PARAMETERS F!
    RETURN SUBSTR$(STR$(F!),1,.)

endproc

proc TSND

    PARAMETERS V&
    var S$=STRI(V&)
    var L&=LEN(S$)
    var T&=(L&-1)3

    WHILELOOP T&

        S$=INS$(.,S$,L&-&LOOP*3+1)

    ENDWHILE

    RETURN S$

endproc

proc STOALLOWEDCHARS

    PARAMETERS S$,ALWDCHRS$
    var C&=LEN(S$)
    var I&=0

    IFNOT C&

        RETURN

    ENDIF

    WHILE 1

        INC I&

        IFNOT INSTR(SUBSTR$(S$,I&),ALWDCHRS$)

            S$=DEL$(S$,I&,1)
            DEC I&
            DEC C&

        ENDIF

        IF I&=C&

            BREAK

        ENDIF

    ENDWHILE

    RETURN S$

endproc

proc WHILE_REPLACE

    PARAMETERS S$,FROM$,_TO$

    WHILE INSTR(FROM$,S$)

        S$=TRANSLATE$(S$,FROM$,_TO$)

    ENDWHILE

    RETURN S$

endproc

proc SARRTOSTRING

    PARAMETERS ARR$[],E$
    var C&=SIZEOF(ARR$[])-1

    IF C&<0

        RETURN

    ENDIF

    var S$=

    WHILELOOP 0,C&

        S$=S$+ARR$[&LOOP]+E$

    ENDWHILE

    RETURN S$

endproc

proc FGETFILEEXT

    PARAMETERS FLE$

    IFNOT INSTR(.,FLE$)

        RETURN

    ENDIF

    RETURN LASTSUBSTR(FLE$,.)

endproc

proc FGETFNAMEFROM

    PARAMETERS S$
    RETURN LASTSUBSTR(S$,\)

endproc

proc FGETPATHFROM

    PARAMETERS S$
    RETURN NOTLASTSUBSTR(S$,\)+\

endproc

proc FGC

    PARAMETERS FLE$

    IF %PCOUNT<1

        RETURN

    ENDIF

    var B&=FILESIZE(FLE$)

    IF B&<1

        RETURN

    ENDIF

    DECLARE MEM#
    DIM MEM#,B&
    var R&=BLOCKREAD(FLE$,MEM#,0,B&)
    var S$=CHAR$(MEM#,0,R&)
    DISPOSE MEM#
    RETURN S$

endproc

proc FPC

    PARAMETERS FLE$,S$

    IF %PCOUNT<1

        RETURN

    ENDIF

    IF %PCOUNT<2

        S$=

    ENDIF

    var L&=LEN(S$)

    IF L&=0

        var FH&=ASSIGN(FLE$)
        REWRITE FH&
        CLOSE FH&
        ASSIGN FH&,
        RETURN

    ENDIF

    DECLARE MEM#
    DIM MEM#,L&+1
    STRING MEM#,0=S$
    BLOCKWRITE FLE$,MEM#,0,L&
    DISPOSE MEM#

endproc

proc FMKDIR

    PARAMETERS DNAME$

    IF %PCOUNT<1

        RETURN

    ENDIF

    IF DIREXISTS(DNAME$)

        RETURN 2

    ENDIF

    MKDIR DNAME$
    RETURN DIREXISTS(DNAME$)

endproc

proc FDELETE

    :!>Löscht die Datei fname$ und liefert als Rückgabewert den Erfolg der Operation.
    PARAMETERS FNAME$

    IF %PCOUNT<1

        RETURN

    ENDIF

    IFNOT FILEEXISTS(FNAME$)

        RETURN 2

    ENDIF

    var FH%=ASSIGN(FNAME$)

    IFNOT FH%

        RETURN 0

    ENDIF

    ERASE #FH%
    ASSIGN #FH%,
    RETURN 1-FILEEXISTS(FNAME$)

endproc

proc FTRYDELETE

    PARAMETERS FLE$,MSTIMEOUT&

    IF %PCOUNT<1

        RETURN

    ENDIF

    IF %PCOUNT<2

        MSTIMEOUT&=8000

    ENDIF

    IFNOT FILEEXISTS(FLE$)

        RETURN 1

    ENDIF

    IF FDELETE(FLE$)

        RETURN 1

    ENDIF

    MSTIMEOUT&=MSTIMEOUT&+&GETTICKCOUNT

    WHILE 1

        SLEEP 100

        IF FDELETE(FLE$)

            BREAK

        ENDIF

        IF &GETTICKCOUNT>MSTIMEOUT&

            BREAK

        ENDIF

    ENDWHILE

    RETURN 1-FILEEXISTS(FLE$)

endproc

proc FCHDIR

    PARAMETERS DNAME$
    var OP$=LOWER$(GETDIR$(@))

    IF DIREXISTS(DNAME$)

        CHDIR DNAME$

    ENDIF

    RETURN IF(LOWER$(GETDIR$(@))=DNAME$,1,0)

endproc

WINDOWSTYLE 1 | 2 | 4 | 8 | 16 | 512
CLS
USERMESSAGES $0010,$0014
var HPIC&=CREATE(hHPGLPic,FGC(1.plt),400,400,$FFAA99)

IFNOT HPIC&

    MESSAGEBOX(Bild konnte nicht erzeugt werden.,,4096)

ENDIF

DRAWPIC HPIC&,10,10;0

WHILE 1

    WAITINPUT

    SELECT %UMESSAGE

        CASEOF $0010

        BREAK

    ENDSELECT

ENDWHILE

end

subproc CREATE.HHPGLPIC

    PARAMETERS __HPGLDATA$,PICWIDTH&,PICHEIGHT&,BGCOLOR&
    RETURN HPGL.CREATEHPIC(__HPGLDATA$,PICWIDTH&,PICHEIGHT&,BGCOLOR&)

endproc

proc HPGL.CREATEHPIC

    PARAMETERS __HPGLDATA$,PICWIDTH&,PICHEIGHT&,BGCOLOR&
    DECLARE CMDS$[]
    CMDS$[]=EXPLODE(TRIM$(WHILE_REPLACE(TRANSLATE$(TRANSLATE$(__HPGLDATA$,;,x0A),x0D,x0A),x0A+x0A,x0A)),x0A)
    var C&=SIZEOF(CMDS$[])

    IFNOT C&

        RETURN 0

    ENDIF

    IF (C&=1) AND (CMDS$[0]=)

        RETURN 0

    ENDIF

    var PEN.ISDOWN%=0
    var PEN.CURRENT%=0
    var PEN.LINETYP%=0
    var PEN.X!=0
    var PEN.Y!=0
    DECLARE CMDLINE$[]
    var I&=0
    DECLARE PAINTLIST$[]
    var S$=

    WHILELOOP 0,C&-1

        S$=INS$(,,TRANSLATE$(TRIM$(WHILE_REPLACE(CMDS$[&LOOP],  , )), ,,),3)

        IF LEN(S$)=3

            S$=DEL$(S$,3,1)

        ENDIF

        CMDLINE$[]=EXPLODE(S$,,)

        SELECT UPPER$(CMDLINE$[0])

            CASEOF IN

            CASEOF WU

            CASEOF VS

            CASEOF PW

            CASEOF SP

            PEN.CURRENT%=VAL(CMDLINE$[1])

            CASEOF LT

            IF SIZEOF(CMDLINE$[])>1

                PEN.LINETYP%=CMDLINE$[1]

                SELECT CMDLINE$[1]

                    CASEOF 1,2,3,4,5,6

                    USEPEN 0,0,1
                    OTHERWISE
                    USEPEN 0,0,1

                ENDSELECT

            ENDIF

            CASEOF PA

            IF SIZEOF(CMDLINE$[])>1

                WHILELOOP 0,(SIZEOF(CMDLINE$[])-1)*0.5-1

                    HPGL.CREATEHPIC.PEN.MOVETO(VAL(CMDLINE$[&LOOP*2+1]),VAL(CMDLINE$[&LOOP*2+2]))

                ENDWHILE

            ENDIF

            CASEOF PU

            PEN.ISDOWN%=0

            IF SIZEOF(CMDLINE$[])>1

                WHILELOOP 0,(SIZEOF(CMDLINE$[])-1)*0.5-1

                    HPGL.CREATEHPIC.PEN.MOVE(VAL(CMDLINE$[&LOOP*2+1]),VAL(CMDLINE$[&LOOP*2+2]))

                ENDWHILE

            ENDIF

            CASEOF PD

            PEN.ISDOWN%=1

            IF SIZEOF(CMDLINE$[])>1

                WHILELOOP 0,(SIZEOF(CMDLINE$[])-1)*0.5-1

                    HPGL.CREATEHPIC.PEN.MOVE(VAL(CMDLINE$[&LOOP*2+1]),VAL(CMDLINE$[&LOOP*2+2]))

                ENDWHILE

            ENDIF

        ENDSELECT

    ENDWHILE

    C&=SIZEOF(PAINTLIST$[])

    IFNOT C&

        RETURN 0

    ENDIF

    DECLARE PAINTDATA$[]
    var VMINX!=0
    var VMINY!=0
    var VMAXX!=0
    var VMAXY!=0
    var FX!=0
    var FY!=0
    var FXX!=0
    var FYY!=0
    var VSET%=0

    WHILELOOP 0,C&-1

        PAINTDATA$[]=EXPLODE(PAINTLIST$[&LOOP],x0A)

        SELECT PAINTDATA$[0]

            CASEOF line

            FX!=VAL(PAINTDATA$[1])
            FY!=VAL(PAINTDATA$[2])
            FXX!=VAL(PAINTDATA$[3])
            FYY!=VAL(PAINTDATA$[4])
            HPGL.CREATEHPIC.PAINTDATA.SETMINMAX(FX!,FY!)
            HPGL.CREATEHPIC.PAINTDATA.SETMINMAX(FXX!,FYY!)

            CASEOF arc

        ENDSELECT

    ENDWHILE

    var XD!=VMAXX!-VMINX!
    var YD!=VMAXY!-VMINY!

    IF VMAXX!=0

        RETURN 0

    ENDIF

    IF VMAXY!=0

        RETURN 0

    ENDIF

    var SX!=(PICWIDTH&-10)/XD!
    var SY!=(PICHEIGHT&-10)/YD!
    var VSX!=VMINX!*SX!
    var VSY!=VMINY!*SY!
    var HPIC&=CREATE(hNewPic,PICWIDTH&,PICHEIGHT&,BGCOLOR&)

    IFNOT HPIC&

        RETURN 0

    ENDIF

    STARTPAINT HPIC&

    WHILELOOP 0,C&-1

        PAINTDATA$[]=EXPLODE(PAINTLIST$[&LOOP],x0A)

        SELECT PAINTDATA$[0]

            CASEOF line

            FX!=VAL(PAINTDATA$[1])*SX!-VSX!+5
            FY!=VAL(PAINTDATA$[2])*SY!-VSY!+5
            FXX!=VAL(PAINTDATA$[3])*SX!-VSX!+5
            FYY!=VAL(PAINTDATA$[4])*SY!-VSY!+5
            USEPEN 0,0,0
            LINE FX!,FY! - FXX!,FYY!

            CASEOF arc

        ENDSELECT

    ENDWHILE

    ENDPAINT
    RETURN HPIC&

    proc HPGL.CREATEHPIC.PAINTDATA.SETMINMAX

        PARAMETERS X!,Y!

        IFNOT VSET%

            VSET%=1
            VMINX!=X!
            VMAXX!=X!
            VMINY!=Y!
            VMAXY!=Y!
            RETURN

        ENDIF

        IF VMINX!>X!

            VMINX!=X!

        ENDIF

        IF VMAXX!<X!

            VMAXX!=X!

        ENDIF

        IF VMINY!>Y!

            VMINY!=Y!

        ENDIF

        IF VMAXY!<Y!

            VMAXY!=Y!

        ENDIF

    endproc

    proc HPGL.CREATEHPIC.PEN.MOVE

        PARAMETERS X!,Y!

        IF PEN.ISDOWN%

            HPGL.CREATEHPIC.PAINTLIST.ADD(line+x0A+STR$(PEN.X!)+x0A+STR$(PEN.Y!)+x0A+STR$(PEN.X!+X!)+x0A+STR$(PEN.Y!+Y!))

        ENDIF

        PEN.X!=PEN.X!+X!
        PEN.Y!=PEN.Y!+Y!

    endproc

    proc HPGL.CREATEHPIC.PEN.MOVETO

        PARAMETERS X!,Y!

        IF PEN.ISDOWN%

            HPGL.CREATEHPIC.PAINTLIST.ADD(line+x0A+STR$(PEN.X!)+x0A+STR$(PEN.Y!)+x0A+STR$(X!)+x0A+STR$(Y!))

        ENDIF

        PEN.X!=X!
        PEN.Y!=Y!

    endproc

    proc HPGL.CREATEHPIC.PAINTLIST.ADD

        PARAMETERS TODO$
        TODO$=TODO$+x0A+STR$(PEN.CURRENT%)+x0A+STR$(PEN.LINETYP%)
        PAINTLIST$[SIZEOF(PAINTLIST$[])]=TODO$

    endproc

endproc

end

hpgl.zip	468 kB

Hochgeladen:	07/10/08

Downloadcounter:
		Download

07/10/08 ▲

Dieter
Zornow

what goes on your Program, 1.plt is a perfekter circle, whom I with your Prog not discern can.
Perhaps to 20 Schnaps

enclosed Screenshoot from the Orginaldatei 1.plt

kreis.png	3 kB

Hochgeladen:	07/11/08

Downloadcounter:
		Download

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2

Web
Scanner

@IF
the program has plenty work made...I know it very

-..only me appear one Kringel and no circle- startup

because I it again not expect could, have I me meanwhile a Own Inputroutine written. my Version is sure not integrally so profi, as your made, but functions integrally well.

It's all right too for several items - means 100 Kreise or Squares etc .usf.
i think too, its with so of/ one complex Thematik not so simply, whole Programmteile dazuzunehmen, its function one not 100% blickt.

the next will be, the one:

1. the indicated Image move can
2. into Image zoomen can
3. The different Vektoren anclicken can and on whom Endpunkten in different directions wander can and the whole against Save can....

there's still a lot to be done

Regards

Web

Xprofan X3.1

Win7 auf AMDX6

- Page 4 -

Verbucht as X11 Testcode, and No - of plenty work can no speech his.

unfortunately was I do not clear the it had one circle go should.

Have whom Vertipper found - Yes it watts one circle!

I werd the time here somehow useable abspeichern as include or so...

Nachtrag: Jupp: [...]

circa at least the Initialposting To answer:

Web Scanner

hpgl-Include [...]

can the already integrally well...

PS: I knows the You in the meantime yet others Anforderungen have (z.B. Edit etc) - The Include itself however mere so befasst one Image darzustellen.

Ausserdem wished I that here at all ever one code about HPGL abrufbar is.