TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: qjchen on June 15, 2010, 10:31:39 AM
-
Thanks to David Bethel : http://www.cadtutor.biz/forum/showthread.php?t=5457
and
the author of http://autolisp.mapcar.net/lambda.html (sorry I dont know German, I cant get the author's name)
I just add some code to enjoy myself about the dynamic 3dmesh
;;;by David Bethel : http://www.cadtutor.biz/forum/showthread.php?t=5457
(defun draw_mesh (vlist mmesh nmesh mflg nflg / cflg)
(and (= (type vlist) 'LIST)
(= (type nmesh) 'INT)
(= (type mmesh) 'INT)
(< nmesh 256)
(< mmesh 256)
(> nmesh 2)
(> mmesh 2)
(cond ((and nflg mflg) (setq cflg 49))
(nflg (setq cflg 48))
(mflg (setq cflg 17))
(t (setq cflg 16)))
(entmake (list (cons 0 "POLYLINE")(cons 66 1)
(cons 6 "BYLAYER")
(cons 10 (list 0 0 0))
(cons 70 cflg)
(cons 71 mmesh)(cons 72 nmesh)
(cons 39 0)))
(foreach v vlist
(entmake (list (cons 0 "VERTEX")
(cons 6 "BYLAYER")
(cons 10 v)
(cons 70 64))))
(entmake (list (cons 0 "SEQEND")))
))
;;;; from http://autolisp.mapcar.net/lambda.html
(defun genlist(expr steps xpi ypi scale / plist tlist xn yn zn)
(setq plist nil)
(setq xn 0.0 yn 0.0)
(repeat(* xpi steps)
(setq tlist nil)
(setq yn 0.0)
(repeat(* ypi steps)
(setq zn(* scale ((eval expr) xn yn)))
(setq tlist(append tlist(list (list xn yn zn))))
(setq yn(+ yn(/ pi steps)))
)
(setq plist(append plist tlist))
(setq xn(+ xn(/ pi steps)))
)
plist
)
;;;the following is by qjchen@gmail.com
(defun c:test ( / ent1 gr height scale temp)
(setq temp (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "._-view" "_top")
(command "._-view" "_swiso")
(command "zoom" "w" "-10,-10" "15,15")
(setq height (getvar "viewsize"))
(while (= (car (setq gr (grread nil 5 0))) 5)
(if (setq ent1 (entlast))(entdel ent1))
(setq scale (* (/ (- (cadr (cadr gr)) 10) height) 5))
(draw_mesh (genlist '(lambda (x y /) (* (cos x) (cos y))) 10 3 3 scale) 30 30 nil nil )
)
(setvar "cmdecho" temp)
(princ)
)
-
Interesting! :-)
Perhaps another way to code it:
(defun c:test ( / foo spc mesh gr )
;; © Lee Mac ~ 16.06.10
(vl-load-com)
(setq foo (lambda (x y) (* (cos x) (cos y))))
(setq spc
(if
(or
(eq AcModelSpace
(vla-get-ActiveSpace
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(eq :vlax-true (vla-get-MSpace doc))
)
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)
)
)
(setq mesh (LM:AddMesh spc 41 41 (LM:GetPointList foo -10 -10 10 10 0.5 1)))
(while (= 5 (car (setq gr (grread 't 13 0))))
(vla-put-Coordinates Mesh
(LM:3DPointVariant
(LM:GetPointList foo -10 -10 10 10 0.5 (/ (cadadr gr) 2.))
)
)
)
(princ)
)
(defun LM:AddMesh ( space m n lst )
;; © Lee Mac ~ 16.06.10
(if (and (< 2 m 256) (< 2 n 256))
(vla-Add3DMesh space m n (LM:3DPointVariant lst))
)
)
(defun LM:3DPointVariant ( ptLst )
;; © Lee Mac ~ 16.06.10
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-VBDouble
(cons 0 (1- (* 3 (length ptLst))))
)
(apply 'append ptLst)
)
)
)
(defun LM:GetPointList ( foo xmin ymin xmax ymax inc scale / result )
;; © Lee Mac ~ 16.06.10
(
(lambda ( x )
(while (<= (setq x (+ x inc)) xmax)
(
(lambda ( y )
(while (<= (setq y (+ y inc)) ymax)
(setq result (cons (list x y (* scale (foo x y))) result))
)
)
(- ymin inc)
)
)
result
)
(- xmin inc)
)
)
-
Thank you, Lee mac
I find that the speed of your code is much quick.
and, vla-Add3DMesh is better, because sometimes the entmake of 3dmesh need more code and hard to understand.
Thanks again.
-
You're welcome :-)
-
Another one of my favourites - a hyperbolic paraboloid :lol:
(defun c:test ( / foo spc mesh gr )
;; © Lee Mac ~ 16.06.10
(vl-load-com)
(setq foo (lambda (x y) (- (* x x ) (* y y))))
(setq spc
(if
(or
(eq AcModelSpace
(vla-get-ActiveSpace
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(eq :vlax-true (vla-get-MSpace doc))
)
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)
)
)
(setq mesh (LM:AddMesh spc 41 41 (LM:GetPointList foo -10 -10 10 10 0.5 1)))
(while (= 5 (car (setq gr (grread 't 13 0))))
(vla-put-Coordinates Mesh
(LM:3DPointVariant
(LM:GetPointList foo -10 -10 10 10 0.5 (/ (cadadr gr) 100.))
)
)
)
(princ)
)
(defun LM:AddMesh ( space m n lst )
;; © Lee Mac ~ 16.06.10
(if (and (< 2 m 256) (< 2 n 256))
(vla-Add3DMesh space m n (LM:3DPointVariant lst))
)
)
(defun LM:3DPointVariant ( ptLst )
;; © Lee Mac ~ 16.06.10
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-VBDouble
(cons 0 (1- (* 3 (length ptLst))))
)
(apply 'append ptLst)
)
)
)
(defun LM:GetPointList ( foo xmin ymin xmax ymax inc scale / result )
;; © Lee Mac ~ 16.06.10
(
(lambda ( x )
(while (<= (setq x (+ x inc)) xmax)
(
(lambda ( y )
(while (<= (setq y (+ y inc)) ymax)
(setq result (cons (list x y (* scale (foo x y))) result))
)
)
(- ymin inc)
)
)
result
)
(- xmin inc)
)
)
-
:) beautiful dynamic hyperbolic paraboloid figure~
-
A Pringle (http://upload.wikimedia.org/wikipedia/commons/thumb/8/89/Pringles_chips.JPG/250px-Pringles_chips.JPG) 8-)
-
:) , I also like the following spiraling wave function, so I modify the up two code as following, they almost do the same
;;;by David Bethel : http://www.cadtutor.biz/forum/showthread.php?t=5457
(defun draw_mesh (vlist mmesh nmesh mflg nflg / cflg)
(and (= (type vlist) 'LIST)
(= (type nmesh) 'INT)
(= (type mmesh) 'INT)
(< nmesh 256)
(< mmesh 256)
(> nmesh 2)
(> mmesh 2)
(cond ((and nflg mflg) (setq cflg 49))
(nflg (setq cflg 48))
(mflg (setq cflg 17))
(t (setq cflg 16)))
(entmake (list (cons 0 "POLYLINE")(cons 66 1)
(cons 6 "BYLAYER")
(cons 10 (list 0 0 0))
(cons 70 cflg)
(cons 71 mmesh)(cons 72 nmesh)
(cons 39 0)))
(foreach v vlist
(entmake (list (cons 0 "VERTEX")
(cons 6 "BYLAYER")
(cons 10 v)
(cons 70 64))))
(entmake (list (cons 0 "SEQEND")))
))
;;;; from http://autolisp.mapcar.net/lambda.html
(defun genlist(expr steps xpi ypi scale / plist tlist xn yn zn)
(setq plist nil)
(setq xn (- (* pi xpi 0.5)) yn (- (* pi ypi 0.5)))
(repeat(* xpi steps)
(setq tlist nil)
(setq yn (- (* pi ypi 0.5)))
(repeat(* ypi steps)
(setq zn(* scale ((eval expr) xn yn)))
(setq tlist(append tlist(list (list xn yn zn))))
(setq yn(+ yn (/ pi steps)))
)
(setq plist(append plist tlist))
(setq xn(+ xn(/ pi steps)))
)
plist
)
;;;the following is by qjchen@gmail.com
(defun c:test ( / ent1 gr height scale temp)
(setq temp (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "._-view" "_top")
(command "._-view" "_swiso")
(command "zoom" "w" "-10,-10" "15,15")
(setq height (getvar "viewsize"))
(while (= (car (setq gr (grread nil 5 0))) 5)
(if (setq ent1 (entlast))(entdel ent1))
(setq scale (* (/ (- (cadr (cadr gr)) 10) height) 5))
;(draw_mesh (genlist '(lambda (x y /) (* (cos x) (cos y))) 10 3 3 scale) 30 30 nil nil )
(draw_mesh (genlist '(lambda (x y)
(setq a (sqrt (+ (* x x) (* y y))))
(/
(+ (* x (sin (* 4 a))) (* y (cos (* 4 a))))
(1+ a)
)
) 20 3 3 scale) 60 60 nil nil )
)
(setvar "cmdecho" temp)
(princ)
)
or
(defun c:test ( / foo spc mesh gr )
;; ? Lee Mac ~ 16.06.10
(vl-load-com)
(setq foo (lambda (x y) (* (cos x) (cos y))))
(setq spc
(if
(or
(eq AcModelSpace
(vla-get-ActiveSpace
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(eq :vlax-true (vla-get-MSpace doc))
)
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)
)
)
(setq mesh (LM:AddMesh spc 41 41 (LM:GetPointList foo -10 -10 10 10 0.5 1)))
(while (= 5 (car (setq gr (grread 't 13 0))))
(vla-put-Coordinates Mesh
(LM:3DPointVariant
(LM:GetPointList foo -10 -10 10 10 0.5 (/ (cadadr gr) 2.))
)
)
)
(princ)
)
(defun LM:AddMesh ( space m n lst )
;; ? Lee Mac ~ 16.06.10
(if (and (< 2 m 256) (< 2 n 256))
(vla-Add3DMesh space m n (LM:3DPointVariant lst))
)
)
(defun LM:3DPointVariant ( ptLst )
;; ? Lee Mac ~ 16.06.10
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-VBDouble
(cons 0 (1- (* 3 (length ptLst))))
)
(apply 'append ptLst)
)
)
)
(defun LM:GetPointList ( foo xmin ymin xmax ymax inc scale / result )
;; ? Lee Mac ~ 16.06.10
(
(lambda ( x )
(while (<= (setq x (+ x inc)) xmax)
(
(lambda ( y )
(while (<= (setq y (+ y inc)) ymax)
(setq result (cons (list x y (* scale (foo x y))) result))
)
)
(- ymin inc)
)
)
result
)
(- xmin inc)
)
)
3dmesh.png from my AUTOCAD 2004 render, not only from the code.
-
That render looks great :-)