lisp2arx
Visual Programming for AutoLisp
Mathématiques en programmation Lisp..
doc2cpp,doc2lsp, sld2lsp, bmp2dcl,
free__GifCcapture for all-CAD'platforms..
|
Lista Forumurilor Pe Tematici
|
lisp2arx | Reguli | Inregistrare | Login
POZE LISP2ARX
Nu sunteti logat.
|
Nou pe simpatie:
CosminaCSM pe Simpatie.ro
 | Femeie
23 ani
Bucuresti
cauta Barbat
23 - 39 ani |
|
|
admin
Administrator
Din: Bucharest
Inregistrat: acum 13 ani
Postari: 506
|
|
Code:
(action_tile "box1"
(vl-prin1-to-string
'(
(lambda ( / itm tmp )
(if (setq itm (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" $value ")"))))
(if (= 4 $reason)
(cond
( (equal '("..") itm)
(setq lst (KMCAD:LM:getfiles:updatefilelist (set_tile "dir" (setq dir (KMCAD:LM:getfiles:updir dir))) ext rtn)
rtn (KMCAD:LM:getfiles:updateselected dir rtn)
)
)
( (vl-file-directory-p (setq tmp (KMCAD:LM:getfiles:checkredirect (strcat dir "\\" (car itm)))))
(setq lst (KMCAD:LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
rtn (KMCAD:LM:getfiles:updateselected dir rtn)
)
)
( (setq rtn (KMCAD:LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "\\" x)) itm)))
rtn (KMCAD:LM:getfiles:updateselected dir rtn)
lst (KMCAD:LM:getfiles:updatefilelist dir ext rtn)
)
)
)
(if (vl-every '(lambda ( x ) (vl-file-directory-p (strcat dir "\\" x))) itm)
(mode_tile "add" 1)
(mode_tile "add" 0)
))))))) |
Code:
";;;çŕěĺíŕ SuperFlatten"
";;;Âç˙ňî http://forum.dwg.ru/showthread.php?t=25474#"
"(defun KMCAD-all-flatten ( / ss ssObj j)"
" (vlax-map-collection"
" (vla-get-Layers"
" (vla-get-ActiveDocument"
" (vlax-get-acad-object)))"
" '(lambda (x) (vla-put-lock x :vlax-false)))"
" (if (setq ss (ssget \"_X\" (list (cons 410 (getvar \"CTAB\")))))"
" (progn"
" (setq ssObj (mapcar 'vlax-ename->vla-object"
" (mapcar 'cadr (ssnamex ss))) j 0)"
" (foreach Obj ssObj"
" (foreach n '(1e99 -1e99)"
" (if (vl-catch-all-error-p"
" (vl-catch-all-apply"
" '(lambda (x)"
" (vla-move x (vlax-3d-point (list 0 0 0))"
" (vlax-3d-point (list 0 0 n))))"
" (list Obj)))"
" nil"
" (setq j (1+ j)))))"
" (princ (strcat \"\\n\" (rtos (/ j 2.0)) \" Objects Flattened.\")))"
" (princ \"\\n<!> No Objects Found <!>\"))"
" (princ)"
") ; defun KMCAD-all-flatten" |
_______________________________________
|
|
| pus acum 3 ani |
|
|
admin
Administrator
Din: Bucharest
Inregistrat: acum 13 ani
Postari: 506
|
|
Color Lambda
http://www.theswamp.org/Sources/doc/avlisp/#lambda
Code:
(defun LM:True->RGB ( c )
(mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)
(defun LM_True2RGB (c)
(mapcar '(lambda (x) (princ "x=") (princ x) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)
Command: (LM_True2RGB 3245455)
x=8x=16x=24(49 133 143) |
The behavior is different from other languages (>> & << of C, C++, or Java) where more than 32 left shifts (of a 32 bit integer) result in 0. In right shift, the integer appears again on every 32 shifts.
Examples : (lsh 2 1) --> 4
Command: (lsh 2 -1) -->1
Code:
;; True -> OLE - Lee Mac
;; Args: c - [int] True Colour
(defun LM:True->OLE ( c )
(apply 'logior
(mapcar
'(lambda ( x ) (lsh (lsh (lsh (fix c) x) -24) (- x 8)))
'(08 16 24)
)
)
) |
Reincarnarea este posibil sa existe doar pentru oameni, care preiau in genetica ; mostenirea depe alta planeta, alta decat Terra. Daca azi un copil a fost inger inaripat acum--1000mie pe vremea lui Stefan Cel Mare", ; pe Luna acum acel baiat/fata ; la el/ea exista.reincarnare (ce de exemnplu: desenele animate "Sailor Moon" . A mintit "Sailor Moon"? Acum daca exista reincarnarea poate o avea "termen de expirare a reincarnarii" -iar in anii 40..900 e.n. nu exista notiunea de termen de expirare (pe oua , pe chipsuri, pe ciocolata, pe sticlele de bere, ....)
60.6KB
_______________________________________
|
|
| pus acum 3 ani |
|
|
admin
Administrator
Din: Bucharest
Inregistrat: acum 13 ani
Postari: 506
|
|
Tu uite aici cum transforma un
Block Begin..End;; in functie lambda
{......................}: in functie lambda
Code:
((lambda ( / jsp)
(princ "\nSelect polyline")
(while (null (setq jsp (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . ">") (90 . 2) (-4 . "<NOT") (-4 . "&") (70 . 121) (-4 . "NOT>") (-4 . "AND>")))))
(princ "\nOject isn'tvalide")
)
)) |
Noi crestini, nu nu trebuie sâ concentram toata puterea satanei asupra-ortodoxiei, puterea satanei trebuie impartita in mai multe religii.. SI oricum char dacâ noi invigem, noi suntem feiricitii invigatorii sâ nu uitam ca mai existâ si alte tipuri de religii pe glob-- si satana are consolare din alte religii de pe Terra. Noi trebuie sâ intelegem dacâ pleiadienii guverneaza civilizatia 5...6anii per 100anii, si dau ordin si satana primeste iertare 5%-0% dela pleiadieni, = cu T.v.a.iar.noi oameni nu avem ce face!! Doamne IsuseH, trebuie sâ-i iertâm pe semeni nostrii prin post, ascultare la popa si rugâciune.
Code:
(defun c:vp50 (/ ss i vp)
(if (setq ss (ssget "_:L" '((0 . "Viewport"))))
(repeat (setq i (sslength ss))
(setq vp (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
(mapcar '(lambda (pr v) (vlax-put vp pr v))
'("DisplayLocked" "CustomScale" "DisplayLocked")
'(0 0.02 -1)
)
)
)(princ)
) |
_______________________________________
|
|
| pus acum 2 ani |
|
