+ Reply to Thread
Page 2 of 2 FirstFirst 1 2
Results 11 to 17 of 17
  1. #11
    Senior Member
    Discipline
    Civil
    Hippe013's Discipline Details
    Occupation
    Survey Crew Chief / Civil Designer
    Discipline
    Civil
    Details
    Land Survey / Civil Engineering
    Using
    Civil 3D 2017
    Join Date
    Feb 2010
    Location
    North Dakota
    Posts
    373

    Default

    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
    Last edited by Hippe013; 31st Aug 2012 at 06:57 pm. Reason: Snaps Issue

  2. #12
    Quantum Mechanic ReMark's Avatar
    Computer Details
    ReMark's Computer Details
    Operating System:
    Windows 7 Pro 64-bit
    Computer:
    Thinkmate
    Motherboard:
    Intel DX58SO2 LGA1366 X58
    CPU:
    Intel i7-960 Quad-core 3.20GHz 8MB cache
    RAM:
    12GB (3x4GB) PC3-106000 DDR3
    Graphics:
    nVidia Quadro K4200, 4GB GDDR5
    Primary Storage:
    150GB Velocipraptor 10,000 rpm
    Secondary Storage:
    none
    Monitor:
    Dell P24LLH - 24" wide screen LCD
    Discipline
    See details...
    ReMark's Discipline Details
    Occupation
    CAD Draftsman/Designer...chemical manufacturing.
    Discipline
    See details below.
    Details
    I work for a specialty chemical manufacturer. I do a little bit of everything from P&IDs to civil to architectural and structural.
    Using
    AutoCAD 2018
    Join Date
    Nov 2005
    Location
    Norwalk, CT USofA
    Posts
    46,357

    Default

    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.
    "I have only come here seeking knowledge. Things they wouldn't teach me of in college." The Police

    Eat brains...gain more knowledge!

    I'm now a full member of the Society for the Promotion of Mediocrity in CAD. Standards? We don't need no stinkin' standards! Take whatever advice I offer and do the opposite.

  3. #13
    Senior Member
    Discipline
    Civil
    Hippe013's Discipline Details
    Occupation
    Survey Crew Chief / Civil Designer
    Discipline
    Civil
    Details
    Land Survey / Civil Engineering
    Using
    Civil 3D 2017
    Join Date
    Feb 2010
    Location
    North Dakota
    Posts
    373

    Default

    Quote Originally Posted by ReMark View Post
    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. #14
    Super Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2014
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    1,213

    Default

    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-invoke-method *ms* 'add3dface
            (vlax-3d-point (vec->pnt ctr A rad))
            (vlax-3d-point (vec->pnt ctr B rad))
            (vlax-3d-point (vec->pnt ctr C rad))
            (vlax-3d-point (vec->pnt ctr A rad))
          )
          (vlax-invoke-method *ms* 'add3dface
            (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 )
      (vl-load-com)
      (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 rad (getdist ctr "\nEnter Radius: "))
      (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))
        )
      )
      (setq ss (ssadd))
      (face pntA pntB pntC f)
      (if (not el)
        (progn
          (setq el (entnext))
          (ssadd el ss)
          (while (setq el (entnext el))
            (ssadd el ss)
          )
        )
        (while (setq el (entnext el))
          (ssadd el ss)
        )
      )
      (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 )
      (vl-load-com)
      (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 rad (getdist ctr "\nEnter Radius: "))
      (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))
        )
      )
      (setq ss (ssadd))
      (face p0 p1 p2 f)
      (face p1 p2 p3 f)
      (if (not el)
        (progn
          (setq el (entnext))
          (ssadd el ss)
          (while (setq el (entnext el))
            (ssadd el ss)
          )
        )
        (while (setq el (entnext el))
          (ssadd el ss)
        )
      )
      (command "_.ARRAY" ss "" "_P" "_non" ctr 5 "" "")
      (princ)
    )
    Regards, M.R.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  5. #15
    Quantum Mechanic ReMark's Avatar
    Computer Details
    ReMark's Computer Details
    Operating System:
    Windows 7 Pro 64-bit
    Computer:
    Thinkmate
    Motherboard:
    Intel DX58SO2 LGA1366 X58
    CPU:
    Intel i7-960 Quad-core 3.20GHz 8MB cache
    RAM:
    12GB (3x4GB) PC3-106000 DDR3
    Graphics:
    nVidia Quadro K4200, 4GB GDDR5
    Primary Storage:
    150GB Velocipraptor 10,000 rpm
    Secondary Storage:
    none
    Monitor:
    Dell P24LLH - 24" wide screen LCD
    Discipline
    See details...
    ReMark's Discipline Details
    Occupation
    CAD Draftsman/Designer...chemical manufacturing.
    Discipline
    See details below.
    Details
    I work for a specialty chemical manufacturer. I do a little bit of everything from P&IDs to civil to architectural and structural.
    Using
    AutoCAD 2018
    Join Date
    Nov 2005
    Location
    Norwalk, CT USofA
    Posts
    46,357

    Default

    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.
    "I have only come here seeking knowledge. Things they wouldn't teach me of in college." The Police

    Eat brains...gain more knowledge!

    I'm now a full member of the Society for the Promotion of Mediocrity in CAD. Standards? We don't need no stinkin' standards! Take whatever advice I offer and do the opposite.

  6. #16
    Senior Member
    Discipline
    Civil
    Hippe013's Discipline Details
    Occupation
    Survey Crew Chief / Civil Designer
    Discipline
    Civil
    Details
    Land Survey / Civil Engineering
    Using
    Civil 3D 2017
    Join Date
    Feb 2010
    Location
    North Dakota
    Posts
    373

    Default

    Quote Originally Posted by marko_ribar View Post
    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. #17
    Super Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2014
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    1,213

    Default

    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-invoke-method *ms* 'add3dface
            (vlax-3d-point (vec->pnt ctr A rad))
            (vlax-3d-point (vec->pnt ctr B rad))
            (vlax-3d-point (vec->pnt ctr C rad))
            (vlax-3d-point (vec->pnt ctr A rad))
          )
          (vlax-invoke-method *ms* 'add3dface
            (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
          (vlax-invoke-method *ms* 'add3dface
            (vlax-3d-point (vec->pnt ctr A rad))
            (vlax-3d-point (vec->pnt ctr B rad))
            (vlax-3d-point (vec->pnt ctr C rad))
            (vlax-3d-point (vec->pnt ctr A rad))
          )
        )
      )
    )
    
    (defun c:geo4-tetra ( / *ms* f ctr rad p0 p1 p2 p3 )
      (vl-load-com)
      (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 rad (getdist ctr "\nEnter Radius: "))
      ;|
      (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 )
      (vl-load-com)
      (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 rad (getdist ctr "\nEnter Radius: "))
      (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))
        )
      )
      (setq ss (ssadd))
      (face pntA pntB pntC f)
      (if (not el)
        (progn
          (setq el (entnext))
          (ssadd el ss)
          (while (setq el (entnext el))
            (ssadd el ss)
          )
        )
        (while (setq el (entnext el))
          (ssadd el ss)
        )
      )
      (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 )
      (vl-load-com)
      (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 rad (getdist ctr "\nEnter Radius: "))
      (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))
        )
      )
      (setq ss (ssadd))
      (face p0 p1 p2 f)
      (face p1 p2 p3 f)
      (if (not el)
        (progn
          (setq el (entnext))
          (ssadd el ss)
          (while (setq el (entnext el))
            (ssadd el ss)
          )
        )
        (while (setq el (entnext el))
          (ssadd el ss)
        )
      )
      (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.
    Last edited by marko_ribar; 22nd Mar 2017 at 09:29 am. Reason: code corrected...

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

Similar Threads

  1. easy way to make a geodesic dome
    By 64lesabre in forum AutoCAD 3D Modelling & Rendering
    Replies: 6
    Last Post: 10th Aug 2012, 11:38 am
  2. Replies: 0
    Last Post: 1st Sep 2011, 04:20 am
  3. Need Help With Geodesic Dome
    By brian nguyen in forum AutoCAD 3D Modelling & Rendering
    Replies: 8
    Last Post: 21st May 2010, 06:28 pm
  4. geodesic dome
    By sagaro in forum AutoLISP, Visual LISP & DCL
    Replies: 2
    Last Post: 26th Jan 2010, 07:16 am
  5. skylight detail for a geodesic dome
    By micks_27986 in forum AutoCAD 3D Modelling & Rendering
    Replies: 4
    Last Post: 10th Feb 2009, 03:07 pm

Bookmarks

Posting Permissions

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