lisp2arx
Visual Programming for AutoLisp
Mathématiques en programmation Lisp..
doc2cpp,doc2lsp, sld2lsp, bmp2dcl,
free__GifCcapture for all-CAD'platforms..
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
Lisp cl_aclayer_entgride_pp_gridform-vlax.lisp – poza de admin, in Libc_adslisp defun-s · 43.4KB
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.