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 | Lista de useri | Reguli | Cauta | Inregistrare | Login

POZE LISP2ARX

Nu sunteti logat.
Nou pe simpatie:
cryssy pe Simpatie.ro
Femeie
25 ani
Botosani
cauta Barbat
25 - 42 ani
lisp2arx / Listof AutoLisp.R14 / vla-AutoLisp14 - acProgn . AcLambda BeginBlock Moderat de zauchan  
Autor
Mesaj Pagini: 1
admin
Administrator

Din: Bucharest
Inregistrat: acum 10 ani
Postari: 354


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

pus acum 1 an
Site  
admin
Administrator

Din: Bucharest
Inregistrat: acum 10 ani
Postari: 354
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)
        )
    )
)



acprogn aclambda beginblock color (mapcar '(lambda (lsh (lsh (fix -24)) '(8 24))
 )

(defun (c)

60.6KB


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

pus acum 1 an
Site  
admin
Administrator

Din: Bucharest
Inregistrat: acum 10 ani
Postari: 354
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")
    )
))



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

pus acum 10 zile
Site  
Pagini: 1    
Mergi la