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:
i.oana pe Simpatie
 | Femeie
20 ani
Bucuresti
cauta Barbat
20 - 45 ani |
|
|
admin
Administrator
Din: Bucharest
Inregistrat: acum 13 ani
Postari: 506
|
|
Calculeaza Media
Code:
(setq p (list 10 34 34 11) q (list 23 11 11 11))(mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p q) |
=>(16.5 22.5 22.5 11.0)
You can also use (apply) in comjunction with (lambda) :
Code:
(apply '(lambda (x y z) (* x (- y z)))
'(5 20 14)) |
This will return (20-14*5=30)=>30
Code:
(defun get_osmode nil ; by Evgeniy Elpanov
(mapcar
(function cdr)
(vl-remove-if
(function (lambda (x) (zerop (logand (getvar "OSMODE") (car x)))))
'((0 . "_non")
(1 . "_end")
(2 . "_mid")
(4 . "_cen")
(8 . "_nod")
(16 . "_qua")
(32 . "_int")
(64 . "_ins")
(128 . "_per")
(256 . "_tan")
(512 . "_nea")
(2048 . "_app"))))) |
_______________________________________
|
|
| pus acum 3 ani |
|
|
zauchan
Moderator
Inregistrat: acum 12 ani
Postari: 180
|
|
I am looking to sort the following list ("U20" "U10" "U110" "U11" "T1" "V1" to first be sorted alphabetically then numerically so that it ends up being ("T1" "U10" "U11" "U20" "U110" "V1" this is the funtion I am currently using.
Code:
(defun SortAI (lst); = Sort Alphabetically, and within that by Integer value
(vl-sort
(vl-sort lst '(lambda (a b) (< (atoi (substr a 2)) (atoi (substr b 2)))))
'(lambda (c d) (< (substr c 1 1) (substr d 1 1)))
)
) |
30.5KB
_______________________________________
psw: cea de la wjndowsXP gigabyte..
|
|
| pus acum 2 ani |
|
|
zauchan
Moderator
Inregistrat: acum 12 ani
Postari: 180
|
|
Minmize this source
Code:
(defun checkval ()
(or
(and
(numberp (atof (get_tile "left_offset")))
(numberp (atof (get_tile "left_overhang")))
(numberp (atof (get_tile "right_offset")))
(numberp (atof (get_tile "right_overhang")))
) ;end and
(set_tile "error" "Offset and overhang inputs must be numbers!")
)) |
with
Code:
(vl-every (mapcar '(lambda (x)(numberp (atof (get_tile x))))
(list "left_offset" "left_overhang" "right_offset" "right_overhang"))) |
(0.816176 6.48044 10.7246 10.3981 1.90985 8.48824 1.69765 3.39529 24.2404 1.63235 22.3306 1.50176 14.7075 17.4335 13.3526 13.3526 14.5769 5.8275 1.25691 11.8019 9.30441 7.72103 8.03118 4.35838 2.17103 3.65647)
I need help that
1. Which member have less than 4 than set to 4, and it will deduct from greater than 4.
Code:
(mapcar '(lambda ( x ) (cond ( (< x 4) 4 ) ( (> x 4) (- x 4) ) ( t x ) )) lst) |
33KB
_______________________________________
psw: cea de la wjndowsXP gigabyte..
|
|
| pus acum 2 ani |
|
|
zauchan
Moderator
Inregistrat: acum 12 ani
Postari: 180
|
|
Code:
(vla-unmergecells tbl 0 0 0 0)
(vla-setcolumnwidth tbl 0 (* hgt 400.))
(mapcar '(lambda (r1 r2 c1 c2) (vla-mergecells tbl r1 r2 c1 c2))
'(0 0 0 0)
'(1 0 1 1)
'(0 1 3 4)
'(0 2 3 4)
)
(mapcar '(lambda (r c s) (vla-settext tbl r c s))
'(0 0 0 0 1 1)
'(0 1 3 4 1 2)
'("Point \\PNo."
"Coordinates"
"Angles \\P(Deg.)"
"Lengths \\P(m)"
"X"
"Y"
)
)
(mapcar '(lambda (row)
(vla-setrowheight tbl r (* hgt 250.))
(mapcar '(lambda (st)
(vla-settext tbl r (setq c (1+ c)) st)
(vla-setcellalignment tbl r c acMiddleCenter)
)
row
)
(setq r (1+ r)
c -1
)
)
lst
)
)
)
(princ)
)
(vl-load-com) |
Code:
;;=============================================
;; Break many objects with a selected objects
;; Selected Objects create ss to be broken
;;=============================================
(defun c:BreakTouching (/ cmd ss1 ss2)
;; get all objects touching entities in the sscross
;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
(defun gettouching (sscros / ss lst lstb lstc objl)
(and
(setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))
objl (mapcar 'vlax-ename->vla-object lstb)
)
(setq
ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
(cons 410 (getvar "ctab"))))
)
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lst (mapcar 'vlax-ename->vla-object lst))
(mapcar
'(lambda (x)
(mapcar
'(lambda (y)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(vlax-safearray->list
(vlax-variant-value
(vla-intersectwith y x acextendnone)
))))))
(setq lstc (cons (vlax-vla-object->ename x) lstc))
)
) objl)
) lst)
)
lstc
)
(command "._undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ss1 (ssadd))
;; get objects to break
(if (and (not (prompt "\nSelect object(s) to break with & press enter: "))
(setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))
)
(break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
)
(setvar "CMDECHO" cmd)
(command "._undo" "_end")
(princ)
) |
36.3KB
_______________________________________
psw: cea de la wjndowsXP gigabyte..
|
|
| pus acum 2 ani |
|
