1. Registered forum members do not see this ad.

Ok... So C:geoico isn't working quite right yet.... ((Hrm... ) worked last night)

but C:geo8 is working correctly

ok all is working it was just a snaps issue

2. Thank you for sharing your lisp routine with us. I'm sure someone will find it handy. We have requests for help with geodesic domes a couple of times a year.

3. Originally Posted by ReMark
Thank you for sharing your lisp routine with us. I'm sure someone will find it handy. We have requests for help with geodesic domes a couple of times a year.
You're welcome! This was a really fun one to research! Helped me understand the whole recursive function thingy!

4. Yes, Hippe's code is good, but I had time to make some mods. to make the code even better (using of (ssget "_X") in DWG full with other entities is bad in my opinion)...

Code:
```(defun negval ( pnt )
(mapcar '- pnt)
)

(defun vec->pnt ( strt norm mag )
(mapcar '+ strt (mapcar '(lambda ( x ) (* mag x)) norm))
)

;;;(vec->pnt '(0 0 0) '(1 0 0) 1)

(defun normal ( p )
(mapcar '(lambda ( i ) (/ i (sqrt (apply '+ (mapcar '* p p))))) p)
)

(defun face ( A B C n / ab ac bc )
(if (> n 0)
(progn
(setq AB (normal (mapcar '+ A B)))
(setq AC (normal (mapcar '+ A C)))
(setq BC (normal (mapcar '+ B C)))
(setq n (1- n))
(face A AB AC n)
(face B AB BC n)
(face C AC BC n)
(face AB AC BC n)
)
(progn
)
(vlax-3d-point (vec->pnt ctr (negval A) rad))
(vlax-3d-point (vec->pnt ctr (negval B) rad))
(vlax-3d-point (vec->pnt ctr (negval C) rad))
(vlax-3d-point (vec->pnt ctr (negval A) rad))
)
)
)
)

(defun c:geo8 ( / *ms* f ctr rad pntA pntB pntC el ss )
(setq *ms* (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))))
(if (> 0 (setq f (getint "\nEnter nth Order: ")))
(setq f (- f))
)
(setq ctr (getpoint "\nSelect Center of Sphere: "))
(initget 7)
(setq pntA '(0 0 1))
(setq pntB '(0 1 0))
(setq pntC '(1 0 0))
(if (entlast)
(setq el (entlast))
)
(if el
(while (entnext el)
(setq el (entnext el))
)
)
(face pntA pntB pntC f)
(if (not el)
(progn
(setq el (entnext))
(while (setq el (entnext el))
)
)
(while (setq el (entnext el))
)
)
(command "_.ARRAY" ss "" "_P" "_non" ctr 4 "" "")
(princ)
)

(defun c:geoico ( / *ms* f ctr rad x y z u v p0 p1 p2 p3 el ss )
(setq *ms* (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))))
(if (> 0 (setq f (getint "\nEnter nth Order: ")))
(setq f (- f))
)
(setq ctr (getpoint "\nSelect Center of Sphere: "))
(initget 7)
(setq x (sqrt (/ (+ 5.0 (sqrt 5.0)) 10.0))) ;these formulas calculate the
(setq y (sqrt (/ (- 3.0 (sqrt 5.0)) 10.0))) ;vertices of two icosahedral
(setq z (sqrt 0.2))                ;faces, the first having
(setq u (sqrt (/ (- 5.0 (sqrt 5.0)) 10.0))) ;vertices (0 0 1), (x y z),
(setq v (- (* x x)))               ;(u v z), and the second with
(setq p0 (list 0.0 0.0 1.0))       ;vertices (x y z), (u v z),
(setq p1 (list x y z))             ;(x -y -z).
(setq p2 (list u v z))
(setq p3 (list x (- y) (- z)))
(if (entlast)
(setq el (entlast))
)
(if el
(while (entnext el)
(setq el (entnext el))
)
)
(face p0 p1 p2 f)
(face p1 p2 p3 f)
(if (not el)
(progn
(setq el (entnext))
(while (setq el (entnext el))
)
)
(while (setq el (entnext el))
)
)
(command "_.ARRAY" ss "" "_P" "_non" ctr 5 "" "")
(princ)
)```
Regards, M.R.

5. Since my sole purpose for testing was to check that Hippie013's lisp routine worked I started with a new drawing thus there were no other entities to be concerned about. None-the-less, thanks for the improvements. I'm sure someone, someday, will be thankful for the revised version.

6. Originally Posted by marko_ribar
Yes, Hippe's code is good, but I had time to make some mods. to make the code even better (using of (ssget "_X") in DWG full with other entities is bad in my opinion)...
Marko,

I appreciate the update to the code, and Yes, using (ssget "_X") was a poor choice. It is interesting to see my code from 5+ years ago and how different I would write the same code today. I would like to run tests with this code up against an updated version translated into vb.net and see if there is a significant performance change. Maybe if I find time I'll give the translation a go.

Till then, Cheers!

7. Registered forum members do not see this ad.

Hi Hippe, according to 3ds MAX software, it seems that there is also tetrahedral one, but it's ugly... Nevertheless I've coded according to your sub functions and for this one... Also I've rotated main points along X axis, so that now when geodesic sphere (tetrahedral) is created, you can just step in front view and slice it to hemisphere (dome)...

Code:
```(defun negval ( pnt )
(mapcar '- pnt)
)

(defun vec->pnt ( strt norm mag )
(mapcar '+ strt (mapcar '(lambda ( x ) (* mag x)) norm))
)

;;;(vec->pnt '(0 0 0) '(1 0 0) 1)

(defun normal ( p )
(mapcar '(lambda ( i ) (/ i (sqrt (apply '+ (mapcar '* p p))))) p)
)

(defun face ( A B C n / ab ac bc )
(if (> n 0)
(progn
(setq AB (normal (mapcar '+ A B)))
(setq AC (normal (mapcar '+ A C)))
(setq BC (normal (mapcar '+ B C)))
(setq n (1- n))
(face A AB AC n)
(face B AB BC n)
(face C AC BC n)
(face AB AC BC n)
)
(progn
)
(vlax-3d-point (vec->pnt ctr (negval A) rad))
(vlax-3d-point (vec->pnt ctr (negval B) rad))
(vlax-3d-point (vec->pnt ctr (negval C) rad))
(vlax-3d-point (vec->pnt ctr (negval A) rad))
)
)
)
)

(defun face-nomirror ( A B C n / ab ac bc )
(if (> n 0)
(progn
(setq AB (normal (mapcar '+ A B)))
(setq AC (normal (mapcar '+ A C)))
(setq BC (normal (mapcar '+ B C)))
(setq n (1- n))
(face-nomirror A AB AC n)
(face-nomirror B AB BC n)
(face-nomirror C AC BC n)
(face-nomirror AB AC BC n)
)
(progn
)
)
)
)

(defun c:geo4-tetra ( / *ms* f ctr rad p0 p1 p2 p3 )
(setq *ms* (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))))
(if (> 0 (setq f (getint "\nEnter nth Order: ")))
(setq f (- f))
)
(setq ctr (getpoint "\nSelect Center of Sphere: "))
(initget 7)
;|
(setq p0 (normal (list 0.0 0.0 (/ (sqrt 3.0) 2.0))))
(setq p1 (normal (list 0.0 (/ (sqrt 2.0) (sqrt 3.0)) (/ (sqrt 3.0) (- 6.0)))))
(setq p2 (normal (list (/ (sqrt 2.0) (- 2.0)) (/ (- 1.0) (sqrt 6.0)) (/ (sqrt 3.0) (- 6.0)))))
(setq p3 (normal (list (/ (sqrt 2.0) 2.0) (/ (- 1.0) (sqrt 6.0)) (/ (sqrt 3.0) (- 6.0)))))
|;
(setq p0 (trans (polar '(0.0 0.0 0.0) (+ (* 0.5 pi) (atan (/ (sqrt 6.0) 3.0) (/ (sqrt 3.0) 3.0))) 1.0) '(1.0 0.0 0.0) 0))
(setq p1 (trans (polar '(0.0 0.0 0.0) (+ (- (atan (/ (sqrt 3.0) 6.0) (/ (sqrt 2.0) (sqrt 3.0)))) (atan (/ (sqrt 6.0) 3.0) (/ (sqrt 3.0) 3.0))) 1.0) '(1.0 0.0 0.0) 0))
(setq p2 (trans (polar (list 0.0 0.0 (/ (sqrt 2.0) (- 2.0))) (+ (+ pi (atan (/ (sqrt 3.0) 6.0) (/ 1.0 (sqrt 6.0)))) (atan (/ (sqrt 6.0) 3.0) (/ (sqrt 3.0) 3.0))) (/ (sqrt 3.0) 3.0)) '(1.0 0.0 0.0) 0))
(setq p3 (trans (polar (list 0.0 0.0 (/ (sqrt 2.0) 2.0)) (+ (+ pi (atan (/ (sqrt 3.0) 6.0) (/ 1.0 (sqrt 6.0)))) (atan (/ (sqrt 6.0) 3.0) (/ (sqrt 3.0) 3.0))) (/ (sqrt 3.0) 3.0)) '(1.0 0.0 0.0) 0))
(face-nomirror p0 p1 p2 f)
(face-nomirror p1 p2 p3 f)
(face-nomirror p2 p3 p0 f)
(face-nomirror p0 p1 p3 f)
(princ)
)

(defun c:geo8-octa ( / *ms* f ctr rad pntA pntB pntC el ss )
(setq *ms* (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))))
(if (> 0 (setq f (getint "\nEnter nth Order: ")))
(setq f (- f))
)
(setq ctr (getpoint "\nSelect Center of Sphere: "))
(initget 7)
(setq pntA '(0 0 1))
(setq pntB '(0 1 0))
(setq pntC '(1 0 0))
(if (entlast)
(setq el (entlast))
)
(if el
(while (entnext el)
(setq el (entnext el))
)
)
(face pntA pntB pntC f)
(if (not el)
(progn
(setq el (entnext))
(while (setq el (entnext el))
)
)
(while (setq el (entnext el))
)
)
(command "_.ARRAY" ss "" "_P" "_non" ctr 4 "" "")
(princ)
)

(defun c:geo20-icosa ( / *ms* f ctr rad x y z u v p0 p1 p2 p3 el ss )
(setq *ms* (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))))
(if (> 0 (setq f (getint "\nEnter nth Order: ")))
(setq f (- f))
)
(setq ctr (getpoint "\nSelect Center of Sphere: "))
(initget 7)
(setq x (sqrt (/ (+ 5.0 (sqrt 5.0)) 10.0)))
(setq y (sqrt (/ (- 3.0 (sqrt 5.0)) 10.0)))
(setq z (sqrt 0.2))
(setq u (sqrt (/ (- 5.0 (sqrt 5.0)) 10.0)))
(setq v (- (* x x)))
(setq p0 (list 0.0 0.0 1.0))
(setq p1 (list x y z))
(setq p2 (list u v z))
(setq p3 (list x (- y) (- z)))
(if (entlast)
(setq el (entlast))
)
(if el
(while (entnext el)
(setq el (entnext el))
)
)
(face p0 p1 p2 f)
(face p1 p2 p3 f)
(if (not el)
(progn
(setq el (entnext))
(while (setq el (entnext el))
)
)
(while (setq el (entnext el))
)
)
(command "_.ARRAY" ss "" "_P" "_non" ctr 5 "" "")
(princ)
)```
Here is complete code, but I've also noticed that when tetrahedral geodesic sphere is created, some faces are inside it - those just around main vertices of tetrahedron... [EDIT : I think I've corrected this issue - sub function wasn't recursive to itself but it called (face) instead (face-nomirror)]

Regards, and I hope that my intervention is also useful...
M.R.

Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts