Simpatie.ro - matrimoniale
lisp2arx
Visual Programming for AutoLisp Mathématiques en programmation Lisp.. doc2cpp,doc2lsp, sld2lsp, bmp2dcl, free__GifCcapture for all-CAD'platforms.. 		Nou pe simpatie:
crazygirl
Femeie
24 ani
Buzau
cauta Barbat
26 - 80 ani
lisp2arxReguliInregistrareLoginPozeNu sunteti logat. Lista Forumurilor Pe Tematici
lisp2arx / Listof AutoLisp.100 /

vla-AutoLisp14 - acProgn . AcLambda BeginBlock

 Pagini: 1 Moderat de zauchan
#1
admin
Administrator
Din: Bucharest
Postari: 523


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"



_______________________________________
http://www.puiubrat.3x.ro/lisp2arx/lisp ... O2UTM2.pdf
 
   
#2
admin
Administrator
Din: Bucharest
Postari: 523
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,    ....)

vla-AutoLisp14 - acProgn . AcLambda BeginBlock - Color Lambda The behavior is different - Listof AutoLisp.100
vla-AutoLisp14 - acProgn . AcLambda BeginBlock – poza de admin, in Listof AutoLisp.100 · 60.6KB


_______________________________________
http://www.puiubrat.3x.ro/lisp2arx/lisp ... O2UTM2.pdf
 
   
#3
admin
Administrator
Din: Bucharest
Postari: 523
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)
)



_______________________________________
http://www.puiubrat.3x.ro/lisp2arx/lisp ... O2UTM2.pdf
 
   

Topicuri similare

Pagini: 1  
Mergi la