admin
Administrator
Din: Bucharest
Inregistrat: acum 13 ani
Postari: 515
|
|
Code:
#region
nn_vmload
(Defun nn_vmload(/ $rr dyn orl p1 p2 p100 p200 rlc nop askw width x1 y1 x2 y2 x100 y100 x200 y200 qq)
/*c2s: command("undo","m");
dyn=dfn_getx_readkey("[YN]","\nSetvar toEndPoint?(y.yes)(n.no): ");
orl=getvar("OSMODE");
if (dyn=="Y") dfn_osnap_setendp(1,T);
p1=getpoint("\nLower Left Corner: "),
p2=getcorner(p1,"\nUpper Right Corner: ");
p100=list(car(p1),cadr(p2),0.0);
p200=list(car(p2),cadr(p1),0.0);
if (dyn=="Y") dfn_osnap_setendp(0,nil);
nop=list(dfn_enamk_layer("Grid",255),dfn_enamk_layer("Label",7));
if (car(nop)<0) command("-layer","m","Grid","color","255","","");
if (cadr(nop)<0) command("-layer","m","Label","color","7","","");
command("-style","tahoma","tahoma",textheight,"1","0","n","n");
command("layer","s","Grid","","linetype","s","bylayer","","color","5");
dfn_enamk_quadrilateral(p1,p2,p3,p4,"Grid",5,"");
width=getvar("USERR1");
GridSpacing=getvar("USERR2"),
TextHeight=getvar("USERR3"),
php_echo(list("\GridSpacing :<",width,"> : "));
askw=getint(" ");
width=(askw==nil)?1000:askw;
dyn=dfn_getx_readkey("[ID]","\nType of Input?(D.getDist)(I.getInt): ");
if (dyn=="I")
GridSpacing=getint(strcat("\ENTER GRID SPACING <",itoa(GridSpacing),">:")),
TextHeight=getint(strcat("\ENTER HEIGHT OF TEXT:<",rtos(TextHeight,2,3),">"));
else GridSpacing=getdist("\nENTER GRID SPACING:"),
TextHeight=getdist("\nENTER HEIGHT OF TEXT:");
GridSpacing=(GridSpacing==nil)?1000:abs(GridSpacing),
TextHeight==(TextHeight==nil)?75.0:abs(TextHeight);
qq= (TextHeight/4),
x1=car(p1),
y1=cadr(p1),
x2=car(p2),
y2=cadr(p2),
x100=car(p100),
y100=cadr(p100),
x200=car(p200),
x200=cadr(p200),
f1= (x100/d),
f2=fix(f1),
f2=float(f2),
f3=(x100<0)?f2:(f2+1),
f4=(GridSpacing*f3),
x3=f4,
n1= (y1/d),
n2=fix(n1),
n2=float(n2),
n3=(y1 < 0)?n2:(n2+1),
n4=(GridSpacing*n3),
y3=n4,
yy=(y100 > y1)?y100:y1,
yy=(y200 > y100)?y200:yy,
yy=(y2 > y200)?y2:yy;
dfn_ngridy();
x3=dfn_ngridx(x1,y1,x2,y2,x3,y3);
if (x3 < xx) dfn_ngridx(x1,y1,x2,y2,x3,y3);
*/
$rr)
%include=con_kpi
%include=dfn_getx_readkey
%include=dfn_ngridy
%include=dfn_ngridx
%include=dfn_cmd_canceld
#endregion#region
dfn_enamk_layer
//Inf: epscolor=set layer color , only
//Out:$rr=(>0.okai) (<0.error)
(defun dfn_enamk_layer(namelayer epscolor / $rr xls nam fnd old)
/*c2s: nam=(type(namelayer)==quote(STR))?namelayer:"0",
epscolor=(type(epscolor)==quote(INT))?epscolor:7,
old=nil,
xls=tblsearch("LAYER","0"),
fnd=(xls)?0:(-1);
if ((fnd==0) && (nam!="0"))
old=list(tblsearch("LAYER",nam));
$rr=cond((old!=nil) && (car(old)==nil),
list(5100,entmakex(lISt(cons(0,"LAYER"),
cons(100,"AcDbSymbolTableRecord"),
cons(100,"AcDbLayerTableRecord"),
cons(2,nam),
cons(70,0),
cons(62,epscolor))));
(old==nil),list(-5003,"InternalError");
(car(old)),list(1,"AlreadyExists");
list(-5002,"error"));
*/
$rr)
#endregion |
Tu ai 20%..60% dreptate, el ca preot dela caz ,la caz. Preotul=el care a practicat aceastea (fortati, sau de bună voie), trebuie să se roage (o perioadă mai lungă la Sfăntul Ciprian. pentru ghidare. Mireni si preoti=noi nu putem judeca (asa din auzite) astfel pe el=preot. Prima dată il judeca pe el; procurorul Sf_Ciprian. si dacă dacă Sfantul Ciprian ii acorda nota 7minim de iertare(din 10) unui preot vrajitor.?? atunci ce facem noi acuzatorii lui? . Eu=@5996 sunt vaiete vai vaie vaiete vai vai vaiete din Iad, eu păcătosul doamne milueste-mă pe mine din fundul iadului.
Code:
%wfopen(_pathuser("minidump\r01_dfn_enamk_layer.lsp"));
(defun c:r01 ( / xls)
(princ "\nMake layer A")
(if (null (tblsearch "LAYER" "a")) (entmakex (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 "a") (cons 70 0) (cons 62 50))))
(if (null (tblsearch "LAYER" "p")) (entmakex (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 "p") (cons 70 0) (cons 62 50))))
)
(prompt "\nCommand.com=(c:r01)\n")
%fclose();
#region
dfn_getx_readkey
//Inf:Wait until press keys k
(defun dfn_getx_readkey(k574 t469 / retc kbd msg two chk lei)
/*c2s: retc=chr(0),
kbd=(k574>"")?k574:"";
msg=(t469>"")?t469:"\nByA:DragneAdrian2019=T469error<>Str:";
prompt(msg);
for(chk=(strlen(kbd)>1)?0:1;chk==0;)
{ two=0;
while (two!=2)
lei=grread(),
two=car(lei);
retc=strcase(chr(cadr(lei)));
chk=(kbd>"")? ((wcmatch(retc,kbd))?1:0):0;
};
princ(retc);
*/
retc)
#endregion
//Inf:Wait until press keys k
//Inp:k574:keys =("".none)
// m469=(nil.none)(else.prompt message)
//Out:rr:char('A'..'Z')
//Err: "t469errorStr". invalid type of variabile t469, must be STR
//ByA:DragneAdrian
%wfopen(_pathuser("system\~dfn_getx_readkey.lsp"));
(defun c:r00 ( / res jsr)
/*c2s:
res="A";
while (resp!="X")
{ prompt("\nPress X to exit");
res=dfn_getx_readkey("[NX]","Prompt Again(<X>. no then exit)");
};
dyn=dfn_getx_readkey("[DYNC]","Erase old entities(y.yes)(n.no)(d.yes-da)(c.ci-yes): ");
if ($rr && (dyn>"") && (wcmatch(dyn,"*YCD*"))
jsr=command("_.ERASE",ssst,"");else
*/
res)
%fclose();
#region
dfn_enamk_quadrilateral
(defun dfn_enamk_quadrilateral(a173 b173 c173 d173 la color lt / $rr lpt orl)
/*c2s:
$rr=nil,
lpt=list(cons(0,"LWPOLYLINE"),
cons(100,"AcDbEntity"),
cons(100,"AcDbPolyline"),
cons(6,ltype),
cons(8,la),
cons(43,0),
cons(62,color),
cons(90,4),
cons(10,a173),
cons(10,b173),
cons(10,c173),
cons(10,d173),
cons(70,0));
orl=entmakex(lpt),
$rr=(type(orl)==read("ENAME"))?list(RTNORM,orl):list(RTCAN,orl);
*/
$rr)
#endregion
//Inp:p1,p2,p3,p4=point
// ;la=layer name("".layer current)
// ;co=color(256.byLayer)
// ;lt=linetype ("".ByLayer)
//Out:rr=(-1.error layer not found)
// ;(-2.error ent_make)
// ;(0.ok)
//Inf:make new rectangle
//ByA:DragneAdrian
dfn_enamk_quadrilateral(p1,p2,p3,p4,
#region
php_echo
(setq con_princeax "")
//rem: you append one string each lines
(defun str_princ(a101 / rr ad gq) (asserte "A101")
/*c2s:
if (type(con_princeax)!=quote(STR))
con_princeax=_T("");
if (type(a101)==quote(STR))
qq=list(princ(a101),princ(con_princeax));
else { if (car(a101)==nil)
gq=textscr(),
a101=cdr(a101);
foreach(ad,a101,princ(ad),princ(con_princeax));
};
*/
nil)
(defun php_echo(a101 / rr) (str_princ a101))
#endregion
//Inf:Display a multiple princ.
//Inp:a101:list=(if first string is nil then execute the command textscr()
// before)
//Out:nil
//Nam=str_princ
#region
dfn_cmd_canceld
(defun dfn_cmd_canceld( / $rr cx dx ch)
/*c2s: ch=quote(INT),
cx=_T("CMDACTIVE"),
dx=getvar(cx),
dx=(type(dx)!=ch)?0:(dx&1);
for(;(dx>0);$rr=command(""))
dx=getvar(cx),
dx=(dx&1);
$rr=getvar("CMDNAMES");
terpri();
*/
$rr)
#endregion
//Inf:You must be sure the command is not active
// Send cancel to current command
// Because ,berfore the user execute (command "_.ZOOM" "_O" pnr),must
// execute (dfn_cmd_canceld) ,that reason i attached (asserte "A312")
//Out:rr:(nil. eroare a ramas o comanda in executie)
// (else.ok, last command active)
//Bug: for autocad2007 you use command("");
//Old: version command("\\");
;;(asserte "A312")
#region
dfn_osnap_setendp
(Defun dfn_osnap_setendp(u144 odActivate / $rr orl cpl)
/*c2s: orl=_T("OSMODE"),
cpl=(zerop(u144))?0:(u144>0)?1:(u144)?1:0;
$rr=getvar(orl);
if (odActivate&&($rr>16384)) $rr=$rr-16384;
if (p142) setvar(orl,$rr|cpl);
else { $rr= (($rr&cpl)==cpl) ? ($rr-cpl) : nil;
if ($rr) setvar(orl,$rr);
};
cpl=getvar(orl);
if (odActivate&&(cpl>16384)) setvar(orl,cpl-16384);
*/
$rr)
#endregion
//Inf: Seteaza OSNAP cu endp.Daca osnap is off atunci ramane off
// 1.Endp
//Inp:u144:(1.Endpoint on)
// (2. Endp on and osmode=activate)
// (nil.Endpoint off)
//Out:rr:OSMODE
//ByA:DragneAdrian2005
#region
dfn_ngridy
(defun dfn_ngridy ( / h1 h11 t1 t2 xrr prr s1)
/*c2s: h1=lISt(x1,y3),
h11=lISt(x2,y3),
t1=lISt(x100+v-qq,y3+v),
t2=lISt(x200+v,y3+v),
xrr=x2+2*qq,
prr=lISt(xrr,y2),
s1=rtos(y3,2,0);
command("layer","s","Grid","","linetype","s","bylayer","","color","bylayer","line",h1,h11,"");
command("layer","s","Label","","color","bylayer","text","s","tahoma","j","mr",t1,0,s1);
command("mirror","l","",p100,p1,"","move","l","",p100,p2,"justifytext","l","","ml");
y3= (y3+d);
if (y3 < y) dfn_ngridy();
xx=x1,
xx=(x100>x1)?x100:x1,
xx=(x200>x100)?x200:xx,
xx=(x2>200)?x2:x2;
*/
nil)
#endrEgion
#region
coff_linkerarx
%wfopen(_pathuser("buildcrt.cmd"));
@cls
@Echo off
@Echo Please protect your Lisp...
copy ^/*c:# _fnP(_pathuser("inc\resource.h"));*/ ^/*c:# _fnP(_pathuser("inc\lspfn_acad14.h"));*/
copy ^/*c:# _getvar("topoglist_headerlistcopy");*/ ^/*c:# _fnP(_pathuser("a.txt"));*/
copy ^/*c:# _fnP(_pathname(".lsp"));*/ ^/*c:# _fnP(_pathname(".c"));*/
erase ^/*c:# _fnP(_pathname(".lsp"));*/
copy ^/*c:# _fnP(_pathuser("a.txt"));*/ ^/*c:# _fnP(_pathname(".lsp"));*/
erase ^/*c:# _fnP(_pathuser("a.txt"));*/
erase %0
erase %0
echo ncad.exe=C:\vlaxcompil\template\ac2014\balotesti_reteauacadastrala.cab
echo oemlogon.gif=c:\vlaxcompil\0user\samples\pp_circle32pat.gif
%fclose();
#endregion
#region
dfn_ngridx
(Defun dfn_ngridx(x1 y1 x2 y2 x3 y3 / v1 ydd dyn)
/*c2s:v1=lISt(x3,y1),
v11=lISt(x3,y2),
r1=lISt(x3-v,y2+v+qq),
r2=lISt(x3-v,y2+1+v),
ydd=y1-qq*2+ss,
pdd=lISt(x1,ydd),
w1=rtos(x3,2,0),
command("layer","s","Grid","","linetype","s","bylayer","","color","bylayer","line",v1,v11,"");
command("layer","s","Label","","color","bylayer","text","s","tahoma","j","bc",r1,0,w1);
dyn=dfn_getx_readkey("[YN]","\nTry Mirror?(y.yes)(n.no): ");
if (dyn=="Y")
command("mirror","l","",p100,p2,"","move","l","",p100,p1,"justifytext","l","","tc");
x3= (x3+d);
*/
x3)
%include=dfn_getx_readkey
#endrEgion
#region
dfn_cad_amain2
(DeFun C:q2()
/*c2s: dfn_pp_v1chkR=nil;*/
(^/*c:# _fnP(_name(""));*/_app)
)
%fopen(_pathuser("inc\lspfn_startvar.h"));
(setq const_systasserte nil acad__assertNo 0)
%fclose();
(Defun asserte(mssg / rr)
/*c2s: acad__assertNo=acad__assertNo+1,
if (mssg!=nil) erprv=erlsp,
erlsp=mssg;
*/
erlsp)
(DeFun C:^/*c:# _fnP(_name(""));*/_app()
(^/*c:# _fnP(_name(""));*/_app )
)
(prompt "\nCommand.com= C:Q2[enter] or Q2[enter]\n")
(Defun ^/*c:# _fnP(_name(""));*/_app( / )
%fopen(_pathuser("inc\resource.h"));
(princ)
%fclose();
#endregion
#region
-all command
;STDCALL call.name= (call_stas) arg[1]= str.choice(0) NN.* nn_^(i30) 0 0 arg[2]= string.all inp[23]= "^(i0) ^(i31)" inp[25]= "(setq _ax (^(i0) ^(i1)))" proc.name= ^(i0)
;SYSCALL call.name= (call_stas) arg[1]= str.choice(0) PIF.* dfn_^(i30) 0 0 arg[2]= string.all inp[23]= "^(i0) ^(i31)" inp[25]= "(setq _sys (^(i0) ^(i1)))" proc.name= ^(i0)
;$M= call.name= (call_copy_source) arg[1]= string.all inp[23]= null inp[25]= ^(i0)
;// call.name= (call_copy_source) arg[1]= string.all inp[25]= " //^(i0)" bta$instr_test= bta$instr_pred
#endregion
#region
dfn_ent_assoclist
(defun dfn_ent_assoclist(a020 / rr ff ye ys yl)
/*c2s:
ff=a020,
ye=quote(ENAME),
yl=quote(LIST),
ys=quote(PICKSET);
if (type(ff)==ys) ff=ssname(a020,0);
rr=(type(ff)==ye) ? entget(ff):
(acand(ff!=nil,type(ff)==yl))? ff:nil;
*/
rr)
#endregion
//Inf: get list
//Inp:a020:lista=okai
// :integer=error
//Out:rr:..(cdr..) or nil for notfound
cls&color C&start vlaxcompil.exe "%0" * -winmode&exit
[config.sys]
uselib=pp_gridform.vlax
user_options=AutoCAD_Lisp_No_Header
use_opt=AutoCAD_Lisp_No_Header
source_lib=acadvlisp
namefile=pp_pline_reverse.bat
;stdcall nn.vmload
#region
con_kpi
(defun con_kpi(/ )
/*c2s:
kpi=3.14159265358979323846;
kHalfPi=1.57079632679489661923;
kTwoPi = 6.28318530717958647692;
kpi_max=3.14159265358979323846264338327950288;
*/
)
#endregion
#region
const_dimepsi
%fopen(_pathuser("inc\lspfn_startvar.h"));
(if (equal const_dimepsi nil)
(setq const_dimepsi 0.00001000000000)
)
(if (equal const_zero nil)
(setq const_zero 1e-10)
)
%fclose();
#endregion
#region
dfn_cad_amain_procstart
^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)^(n)
#endregion
#region
dfn_cad_amain_eof2
(prompt "\ncommand.com: Q2[enter]\n")
%include=coff_linkerarx
#endregion
#region
dfn_cad_amain_callend2
/*c2s: princ("\nEnd");*/
T)
#endregion
#region
dfn_cad_amain_procstop
;Lib:free
#endregion
#region
dfn_cad_aPages
;(^0)
#endregion |
43.4KB
_______________________________________
|
|