Author Topic: Explode non-uniformly scaled block ?  (Read 8251 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Explode non-uniformly scaled block ?
« on: December 17, 2011, 06:55:35 AM »
As I wrote in title, is this possible? I ran into modeling problem in CAD. I know this isn't place to post this issue, but who knows, maybe I'll get some help or a direction what to do...
The problem is modeling an ellipsoid with all 3 radius different... My attempt to doing this was to make block with sphere with radius 1.0 and then to change its X, Y and Z scaling properties... But unfortunately, the block isn't uniformly scaled and can't be exploded to 3DSolid entity even though while making block I turned on allow exploding button...

So any help will be appreciated...
Sincerely, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

SEANT

  • Bull Frog
  • Posts: 345
Re: Explode non-uniformly scaled block ?
« Reply #1 on: December 17, 2011, 07:27:10 AM »
I don’t think AutoCAD allows the explosion of Non Uniformly Scaled Blocks containing any of the ShapeManager entities (3D Solids/Surfaces, Regions).

I did create a rudimentary routine (.NET) to create such a solid.  You may have to register to see the post.

http://www.acadnetwork.com/topic-104.0.html
Sean Tessier
AutoCAD 2016 Mechanical

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Explode non-uniformly scaled block ?
« Reply #2 on: December 17, 2011, 04:47:48 PM »
Can someone help me here... I wrote what I want in my *.dwg... Seant, I didn't see what you did, I don't know to answer to register verification question (name of library, monkey, Sunday ?)

Any help would be nice...
Sincerely, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Explode non-uniformly scaled block ?
« Reply #3 on: December 17, 2011, 06:57:49 PM »
Never mind, I've found out how to do it... And checked Volume of ellipsoid = 4/3*PI*r1*r2*r3; similar for sphere = 4/3*PI*r^3; and analogy goes and for areas - for circle = r^2*PI; for ellipse = a*b*PI

Code: [Select]
(defun c:ellipsoid ( / CE DXF11 DXF40 EL H MESH1 MESH2 MESH3 MESH4 MESH5 MESH6 MESH7 MESH8 OSM PTST SP1 SP1CV SP1EN SP1ST SP2 SP23 SP2CV SP2EN SP2NOR SP2ST SP3 SP3CV SP3EN SP3NOR SP3ST ST1 ST2 SURF1 SURF2 SURF3 SURF4 SURF5 SURF6 SURF7 SURF8 SURFACES )
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (command "_.UCS" "w")
  (prompt "\nPick center of ellipsoid : ")
  (command "_.ellipse" "c")
  (while (eq 1 (logand 1 (getvar 'cmdactive))) (command pause))
  (setq el (entlast))
  (setq ce (cdr (assoc 10 (entget el))))
  (setq dxf11 (cdr (assoc 11 (entget el))))
  (setq dxf40 (cdr (assoc 40 (entget el))))
  (initget 5)
  (setq h (getdist ce "\nPick height of ellipsoid : "))
  (entdel el)
  (setq ptst (mapcar '+ ce dxf11))
  (setq sp1st ptst)
  (setq sp1en (polar ce (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1cv (polar sp1st (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 sp1st) (cons 41 1.0) (cons 10 sp1cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp1en) (cons 41 1.0)) )))
  (command "_.UCS" "3p" sp1st ce "")
  (command "_.UCS" "x" 90)
  (setq sp2st (trans '(0.0 0.0 0.0) 1 0))
  (setq sp2en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp2cv (trans (list 0.0 h 0.0) 1 0))
  (if (equal (caddr sp2en) (caddr sp2cv) 1e-4) () (setq sp2cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (setq sp2nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
  (setq sp2 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp2nor) (cons 10 sp2st) (cons 41 1.0) (cons 10 sp2cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp2en) (cons 41 1.0)) )))
  (command "_.UCS" "p")
  (command "_.UCS" "p")
  (command "_.UCS" "3p" sp1en ce "")
  (command "_.UCS" "x" 90)
  (setq sp3st (trans '(0.0 0.0 0.0) 1 0))
  (setq sp3en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp3cv (trans (list 0.0 h 0.0) 1 0))
  (if (equal (caddr sp3en) (caddr sp3cv) 1e-4) () (setq sp3cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (setq sp3nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
  (setq sp3 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp3nor) (cons 10 sp3st) (cons 41 1.0) (cons 10 sp3cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp3en) (cons 41 1.0)) )))
  (command "_.UCS" "p")
  (command "_.UCS" "p")
  (setq sp23 (entmakex (list '(0 . "LINE") (cons 10 (mapcar '+ ce (list 0.0 0.0 h))) (cons 11 (mapcar '+ ce (list 0.0 0.0 h))))))
  (initget 5)
  (setq st1 (getint "\nEnter surftab1 value : "))
  (initget 5)
  (setq st2 (getint "\nEnter surftab2 value : "))
  (setvar 'surftab1 st1)
  (setvar 'surftab2 st2)
  (command "_.edgesurf" sp1 sp2 sp23 sp3)
  (setq mesh1 (entlast))
  (command "_.mirror" mesh1 "" ce sp1st "")
  (setq mesh2 (entlast))
  (command "_.mirror" mesh1 "" ce sp1en "")
  (setq mesh3 (entlast))
  (command "_.mirror" mesh2 "" ce sp1en "")
  (setq mesh4 (entlast))
  (command "_.mirror3d" mesh1 "" "XY" "" "")
  (setq mesh5 (entlast))
  (command "_.mirror3d" mesh2 "" "XY" "" "")
  (setq mesh6 (entlast))
  (command "_.mirror3d" mesh3 "" "XY" "" "")
  (setq mesh7 (entlast))
  (command "_.mirror3d" mesh4 "" "XY" "" "")
  (setq mesh8 (entlast))
  (setvar 'smoothmeshconvert 3)
  (setvar 'surfacemodelingmode 1)
  (command "_.convtosurface" mesh1 "")
  (setq surf1 (entlast))
  (command "_.convtonurbs" surf1 "")
  (command "_.convtosurface" mesh2 "")
  (setq surf2 (entlast))
  (command "_.convtonurbs" surf2 "")
  (command "_.convtosurface" mesh3 "")
  (setq surf3 (entlast))
  (command "_.convtonurbs" surf3 "")
  (command "_.convtosurface" mesh4 "")
  (setq surf4 (entlast))
  (command "_.convtonurbs" surf4 "")
  (command "_.convtosurface" mesh5 "")
  (setq surf5 (entlast))
  (command "_.convtonurbs" surf5 "")
  (command "_.convtosurface" mesh6 "")
  (setq surf6 (entlast))
  (command "_.convtonurbs" surf6 "")
  (command "_.convtosurface" mesh7 "")
  (setq surf7 (entlast))
  (command "_.convtonurbs" surf7 "")
  (command "_.convtosurface" mesh8 "")
  (setq surf8 (entlast))
  (command "_.convtonurbs" surf8 "")
  (setq surfaces (ssget "_X" '((0 . "NURBSURFACE"))))
  (command "_.surfsculpt" surfaces "")
  (entdel sp1)
  (entdel sp2)
  (entdel sp23)
  (entdel sp3)
  (setvar 'osmode osm)
(princ)
)

Regards, M.R.
:)

Note : this code functions on ACAD2011 & ACAD2012
« Last Edit: December 18, 2011, 10:15:26 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

SEANT

  • Bull Frog
  • Posts: 345
Re: Explode non-uniformly scaled block ?
« Reply #4 on: December 18, 2011, 02:14:01 AM »
Can someone help me here... I wrote what I want in my *.dwg... Seant, I didn't see what you did, I don't know to answer to register verification question (name of library, monkey, Sunday ?)

Any help would be nice...
Sincerely, M.R.

I'm don't recall how AcadNETwork.com registration process worked exactly, but I think the questions are designed to restrict access to just people (i.e., no bots).  It's just as well, I guess, apparently I didn't include a compiled routine - just source code.  I'll get that isolated for compilation and upload it somewhere along the line.  If you ever decide to give .NET a try, that site has some nice samples.

I tried you routine, but I think my AutoCAD setting may be amiss.  The shape is ellipsoid like, but there are some intersecting seams.  See Sample1.dwg.

I've include an ellipsoid of with the same dimensions in Sample2.dwg.
« Last Edit: December 18, 2011, 02:36:32 AM by SEANT »
Sean Tessier
AutoCAD 2016 Mechanical

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Explode non-uniformly scaled block ?
« Reply #5 on: December 18, 2011, 05:23:33 AM »
Seant, I like your Sample2.dwg... It is more precise in massprop calculations and seems like standard primitive - vary nice and simple wire. How did you make it? My routine gives also ellipsoid, but it's from surfsculpted surfaces and I didn't know how to loft segment, so I used edgesurf -> convtosurface -> surfsculpt. And also results of inspecting my ellipsoid with massprop gave me slightly inaccurate results...
Your ellipsoid is surely better, and to conclude file memory assumption by this kind of solid is much, much less than with my type of solid with complex net of vertexes...
I would like to draw your version, can you help me, I don't know nothing ab NET programming, only used to do Vanilla/Visual Lisp...

M.R.
And many thanks for showing your examples, Seant...

Wait a minute, Sample1.dwg is product of my routine? On my comp. it worked fine, but I think I know by looking to your model where is problem... Try to lower fuzz factor in equal statements - look for these lines and replace 1e-8 to lets say 1e-6 :
Code: [Select]
  (if (equal (caddr sp2en) (caddr sp2cv) 1e-6) () (setq sp2cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (if (equal (caddr sp3en) (caddr sp3cv) 1e-6) () (setq sp3cv (trans (list 0.0 (- h) 0.0) 1 0)))
« Last Edit: December 18, 2011, 05:37:56 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

SEANT

  • Bull Frog
  • Posts: 345
Re: Explode non-uniformly scaled block ?
« Reply #6 on: December 18, 2011, 06:21:39 AM »
The fuzz factor modification did not do any better.  It is quite possible that this is related to the issue I mentioned here:

http://www.theswamp.org/index.php?topic=40414.msg457314#msg457314

See the attached “Construction Geometry.dwg”.



I used an octant method as well, See “NURBSurf.dwg”
I don’t know enough about Autolisp to know if ENTMAKEX is capable of generating a generic NURB surface.  See the screen capture of the related ManagedARX docs.

When I retieved the dotted pairs this is returned:

Code: [Select]
Select object: ((0 . "SURFACE") (330 . <Entity name: 7ffff6039f0>) (5 . "206")
(100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 .
"AcDbModelerGeometry") (70 . 1) (1 . "mnjoo mj m mk          ") (1 . "ni
^*+0;:,4 ^*+0\\^[ nf ^LR mnhqoqoqkjol QK o  ") (1 . "mjqlffffffffffffff
fqfffffffffffffffj:rooh n:rono ") (1 . ">,27:>;:- {rn rn _nm mnhqoqoqkjol |")
(1 . "=0;& {rn rn {rn {m {rn {rn |") (1 . "3*2/ {rn rn {rn {rn {l {n |") (1 .
",7:33 {rn rn {rn {rn {rn {k {rn {m |") (1 . "9><: {rn rn {rn {rn {j {l {rn {i
90-(>-; ;0*=3: 0*+ |") (1 . "300/ {rn rn {rn {rn {h {k |") (1 . ",/361:r,*-9><:
{rn rn {rn 90-(>-; $ :'><+@,/3@,*- mnhoo 9*33 1*-=, m m =0+7 0/:1 0/:1 101:
7687 m m ") (1 . " o m nqjhohfilmihfkgfii m ") (1 . " o m nqjhohfilmihfkgfii m
") (1 . " g o o n ") (1 . " g k o oqhohnoihgnngijkhjh ") (1 . " o k o n ") (1 .
" g o m oqhohnoihgnngijkhjh ") (1 . " g k m oqj ") (1 . " o k m
oqhohnoihgnngijkhjh ") (1 . " o o m n ") (1 . " o o m oqhohnoihgnngijkhjh ") (1
. " o o m n ") (1 . " o ") (1 . " o ") (1 . " o ") (1 . " o ") (1 . " o ") (1 .
" o ") (1 . " o ") (1 . " Y Y n Y o Y n Y o JQZGKZQ[Z[ \" V V V V |") (1 .
"<0:;8: {rn rn {rn {g {f {rn {no 90-(>-; {j {nn |") (1 . "<0:;8: {rn rn {rn {f
{h {rn {nm 90-(>-; {j {nl |") (1 . "<0:;8: {rn rn {rn {h {g {rn {nk 90-(>-; {j
{nj |") (1 . ":;8: {rn rn {rn {ni o {nh nqjhohfilmihfkgfii {h {ng 90-(>-; _h
*1410(1 |") (1 . "/<*-): {rn rn {rn o 90-(>-; $ :'/@/>-@<*- 1*=, n 0/:1 m ") (1
. " o n nqjhohfilmihfkgfii n ") (1 . " o o ") (1 . " nqjhohfilmihfkgfii o ") (1
. " o ") (1 . " ,/361: 90-(>-; $ -:9 o \" V V V V ") (1 . " \" o o |") (1 .
":;8: {rn rn {rn {nh o {nf nqjhohfilmihfkgfii {g {mo 90-(>-; _h *1410(1 |") (1
. "/<*-): {rn rn {rn o 90-(>-; $ :'/@/>-@<*- 1*=, n 0/:1 m ") (1 . " o n
nqjhohfilmihfkgfii n ") (1 . " nqjhohfilmihfkgfii o ") (1 . "
nqjhohfilmihfkgfii nqjhohfilmihfkgfii ") (1 . " o ") (1 . " ,/361: 90-(>-; $
-:9 o \" V V V V ") (1 . " \" o o |") (1 . ":;8: {rn rn {rn {nf
rnqjhohfilmihfkgfii {ni ro {f {mn 90-(>-; _h *1410(1 |") (1 . "/<*-): {rn rn
{rn o -:):-,:; $ :'/@/>-@<*- 1*=, n 0/:1 m ") (1 . " o n nqjhohfilmihfkgfii n
") (1 . " o o ") (1 . " o nqjhohfilmihfkgfii ") (1 . " o ") (1 . " ,/361:
90-(>-; $ -:9 o \" V V V V ") (1 . " \" o o |") (1 . "):-+:' {rn rn {rn {no o
{mm |") (1 . "):-+:' {rn rn {rn {no n {ml |") (1 . "61+<*-):r<*-): {rn rn {rn
90-(>-; $ />-@61+@<*- mnhoo 9*33 1*-=, m 0/:1 m ") (1 . " o m
nqjhohfilmihfkgfii m ") (1 . " g o o n ") (1 . " g k o oqhohnoihgnngijkhjh ")
(1 . " o k o n ") (1 . " o ") (1 . " ,/361: 90-(>-; $ -:9 o \" V V V V ") (1 .
" 1*33@,*-9><: ") (1 . " 1*=, n 0/:1 m ") (1 . " o n nqjhohfilmihfkgfii n ") (1
. " o o ") (1 . " nqjhohfilmihfkgfii o ") (1 . " ") (1 . " 1*33=, ") (1 . " V V
") (1 . " o ") (1 . " o ") (1 . " o ") (1 . " ") (1 . " o ,*-9n \" Y o Y
nqjhohfilmihfkgfii |") (1 . "):-+:' {rn rn {rn {nm n {mk |") (1 .
"61+<*-):r<*-): {rn rn {rn 90-(>-; $ />-@61+@<*- mnhoo 9*33 1*-=, m 0/:1 m ")
(1 . " o m nqjhohfilmihfkgfii m ") (1 . " o k o n ") (1 . " o k m
oqhohnoihgnngijkhjh ") (1 . " o o m n ") (1 . " o ") (1 . " ,/361: 90-(>-; $
-:9 o \" V V V V ") (1 . " 1*33@,*-9><: ") (1 . " 1*=, n 0/:1 m ") (1 . " o n
nqjhohfilmihfkgfii n ") (1 . " nqjhohfilmihfkgfii o ") (1 . "
nqjhohfilmihfkgfii nqjhohfilmihfkgfii ") (1 . " ") (1 . " 1*33=, ") (1 . " V V
") (1 . " o ") (1 . " o ") (1 . " o ") (1 . " ") (1 . " o ,*-9n \" Y o Y
nqjhohfilmihfkgfii |") (1 . "61+<*-):r<*-): {rn rn {rn -:):-,:; $ />-@61+@<*-
mnhoo 9*33 1*-=, m 0/:1 m ") (1 . " o m nqjhohfilmihfkgfii m ") (1 . " g o o n
") (1 . " g o m oqhohnoihgnngijkhjh ") (1 . " o o m n ") (1 . " o ") (1 . "
,/361: 90-(>-; $ -:9 o \" V V V V ") (1 . " 1*33@,*-9><: ") (1 . " 1*=, n 0/:1
m ") (1 . " o n nqjhohfilmihfkgfii n ") (1 . " o o ") (1 . " o
nqjhohfilmihfkgfii ") (1 . " ") (1 . " 1*33=, ") (1 . " V V ") (1 . " o ") (1 .
" o ") (1 . " o ") (1 . " ") (1 . " o ,*-9n \" Y rnqjhohfilmihfkgfii Y ro |")
(1 . "/061+ {rn rn {rn g o o |") (1 . "/061+ {rn rn {rn o k o |") (1 . "/061+
{rn rn {rn o o m |") (100 . "AcDbSurface") (71 . 6) (72 . 6))
Sean Tessier
AutoCAD 2016 Mechanical

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Explode non-uniformly scaled block ?
« Reply #7 on: December 18, 2011, 10:28:05 AM »
Look Seant, I don't know to generate your type generic NURB surface as you posted, but I think that construction that you pulled out from routine is wrong due to some settings of your CAD... I've modified code above to set osmode to 0, and even more reduced fuzz factor 1e-4, beside this I read that to get NURBS surface I had to convert from mesh->procedural surface->NURBS surface and again my results are worse than yours, all because this NURBS surface is derived from my firstly created mesh with edgesurf... So, if you'd be kind to instruct me how to crate your type of SURFACE that is simplified and correct one, I'd be vary thankful...

Sincerely, M.R. :-(

P.S. I need to create it in anyway that is possible if entmakex can't be of use, and if there is only one way I'd like to know it...
« Last Edit: December 18, 2011, 10:35:03 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Explode non-uniformly scaled block ?
« Reply #8 on: December 18, 2011, 11:58:39 AM »
Seant, now I did it with lofting, but now surfaces are inaccurate... Look in my *.dwg with comparison to your one. Presentation is adequate, but volume and shape are wrong... Here is my latest code :

Code: [Select]
(defun c:ellipsoid ( / CE DXF11 DXF40 EL H LOFT1 LOFT2 LOFT3 LOFT4 LOFT5 LOFT6 LOFT7 LOFT8 LOFTS OSM PTST SP1 SP1CV SP1EN SP1ST SP2 SP2CV SP2EN SP2NOR SP2ST SP3 SP3CV SP3EN SP3NOR SP3ST ST1 ST2 )
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (command "_.UCS" "w")
  (prompt "\nPick center of ellipsoid : ")
  (command "_.ellipse" "c")
  (while (eq 1 (logand 1 (getvar 'cmdactive))) (command pause))
  (setq el (entlast))
  (setq ce (cdr (assoc 10 (entget el))))
  (setq dxf11 (cdr (assoc 11 (entget el))))
  (setq dxf40 (cdr (assoc 40 (entget el))))
  (initget 5)
  (setq h (getdist ce "\nPick height of ellipsoid : "))
  (entdel el)
  (setq ptst (mapcar '+ ce dxf11))
  (setq sp1st ptst)
  (setq sp1en (polar ce (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1cv (polar sp1st (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 sp1st) (cons 41 1.0) (cons 10 sp1cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp1en) (cons 41 1.0)) )))
  (command "_.UCS" "3p" sp1st ce "")
  (command "_.UCS" "x" 90)
  (setq sp2st (trans '(0.0 0.0 0.0) 1 0))
  (setq sp2en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp2cv (trans (list 0.0 h 0.0) 1 0))
  (if (equal (caddr sp2en) (caddr sp2cv) 1e-4) () (setq sp2cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (setq sp2nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
  (setq sp2 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp2nor) (cons 10 sp2st) (cons 41 1.0) (cons 10 sp2cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp2en) (cons 41 1.0)) )))
  (command "_.UCS" "p")
  (command "_.UCS" "p")
  (command "_.UCS" "3p" sp1en ce "")
  (command "_.UCS" "x" 90)
  (setq sp3st (trans '(0.0 0.0 0.0) 1 0))
  (setq sp3en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp3cv (trans (list 0.0 h 0.0) 1 0))
  (if (equal (caddr sp3en) (caddr sp3cv) 1e-4) () (setq sp3cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (setq sp3nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
  (setq sp3 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp3nor) (cons 10 sp3st) (cons 41 1.0) (cons 10 sp3cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp3en) (cons 41 1.0)) )))
  (command "_.UCS" "p")
  (command "_.UCS" "p")
  (initget 5)
  (setq st1 (getint "\nEnter surfu value : "))
  (initget 5)
  (setq st2 (getint "\nEnter surfv value : "))
  (setvar 'surfu st1)
  (setvar 'surfv st2)
  (command "_.loft" sp2 sp3 "" "g" sp1 "")
  (setq loft1 (entlast))
  (command "_.mirror" loft1 "" ce sp1st "")
  (setq loft2 (entlast))
  (command "_.mirror" loft1 "" ce sp1en "")
  (setq loft3 (entlast))
  (command "_.mirror" loft2 "" ce sp1en "")
  (setq loft4 (entlast))
  (command "_.mirror3d" loft1 "" "XY" "" "")
  (setq loft5 (entlast))
  (command "_.mirror3d" loft2 "" "XY" "" "")
  (setq loft6 (entlast))
  (command "_.mirror3d" loft3 "" "XY" "" "")
  (setq loft7 (entlast))
  (command "_.mirror3d" loft4 "" "XY" "" "")
  (setq loft8 (entlast))
  (setq lofts (ssadd))
  (ssadd loft1 lofts)
  (ssadd loft2 lofts)
  (ssadd loft3 lofts)
  (ssadd loft4 lofts)
  (ssadd loft5 lofts)
  (ssadd loft6 lofts)
  (ssadd loft7 lofts)
  (ssadd loft8 lofts)
  (command "_.surfsculpt" lofts "")
  (entdel sp1)
  (entdel sp2)
  (entdel sp3)
  (setvar 'osmode osm)
(princ)
)

Still I am waiting for your real help...
M.R. Thanks... :-(
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Explode non-uniformly scaled block ?
« Reply #9 on: December 18, 2011, 05:09:44 PM »
My final best attempt using LISP and my knowledge... I've added additional cross section (diagonal) while lofting octant segment, and now volume is less by 1% from real... So here is code and my comparison dwg :

Code: [Select]
(defun c:ellipsoid ( / CE DXF11 DXF40 EL H LOFT1 LOFT2 LOFT3 LOFT4 LOFT5 LOFT6 LOFT7 LOFT8 LOFTS OSM PTST SP1 SP1CV SP1EN SP1ST SP2 SP2CV SP2EN SP2NOR SP2ST SP3 SP3CV SP3EN SP3NOR SP3ST SP4 SP4CV SP4EN SP4NOR SP4ST ST1 ST2 )
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (command "_.UCS" "w")
  (prompt "\nPick center of ellipsoid : ")
  (command "_.ellipse" "c")
  (while (eq 1 (logand 1 (getvar 'cmdactive))) (command pause))
  (setq el (entlast))
  (setq ce (cdr (assoc 10 (entget el))))
  (setq dxf11 (cdr (assoc 11 (entget el))))
  (setq dxf40 (cdr (assoc 40 (entget el))))
  (initget 5)
  (setq h (getdist ce "\nPick height of ellipsoid : "))
  (entdel el)
  (setq ptst (mapcar '+ ce dxf11))
  (setq sp1st ptst)
  (setq sp1en (polar ce (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1cv (polar sp1st (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 sp1st) (cons 41 1.0) (cons 10 sp1cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp1en) (cons 41 1.0)) )))
  (command "_.UCS" "3p" sp1st ce "")
  (command "_.UCS" "x" 90)
  (setq sp2st (trans '(0.0 0.0 0.0) 1 0))
  (setq sp2en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp2cv (trans (list 0.0 h 0.0) 1 0))
  (if (equal (caddr sp2en) (caddr sp2cv) 1e-4) () (setq sp2cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (setq sp2nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
  (setq sp2 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp2nor) (cons 10 sp2st) (cons 41 1.0) (cons 10 sp2cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp2en) (cons 41 1.0)) )))
  (command "_.UCS" "p")
  (command "_.UCS" "p")
  (command "_.UCS" "3p" sp1en ce "")
  (command "_.UCS" "x" 90)
  (setq sp3st (trans '(0.0 0.0 0.0) 1 0))
  (setq sp3en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp3cv (trans (list 0.0 h 0.0) 1 0))
  (if (equal (caddr sp3en) (caddr sp3cv) 1e-4) () (setq sp3cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (setq sp3nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
  (setq sp3 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp3nor) (cons 10 sp3st) (cons 41 1.0) (cons 10 sp3cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp3en) (cons 41 1.0)) )))
  (command "_.UCS" "p")
  (command "_.UCS" "p")
  (setq sp4st (polar ce (angle ce sp1cv) (* (distance ce sp1cv) (sqrt 0.5))))
  (setq sp4en (mapcar '+ ce (list 0.0 0.0 h)))
  (command "_.UCS" "3p" sp4st ce "")
  (command "_.UCS" "x" 90)
  (setq sp4cv (trans (list 0.0 h 0.0) 1 0))
  (if (equal (caddr sp4en) (caddr sp4cv) 1e-4) () (setq sp4cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (setq sp4nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
  (setq sp4 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp4nor) (cons 10 sp4st) (cons 41 1.0) (cons 10 sp4cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp4en) (cons 41 1.0)) )))
  (command "_.UCS" "p")
  (command "_.UCS" "p")
  (initget 5)
  (setq st1 (getint "\nEnter surfu value : "))
  (initget 5)
  (setq st2 (getint "\nEnter surfv value : "))
  (setvar 'surfu st1)
  (setvar 'surfv st2)
  (command "_.loft" sp2 sp4 sp3 "" "g" sp1 "")
  (setq loft1 (entlast))
  (command "_.mirror" loft1 "" ce sp1st "")
  (setq loft2 (entlast))
  (command "_.mirror" loft1 "" ce sp1en "")
  (setq loft3 (entlast))
  (command "_.mirror" loft2 "" ce sp1en "")
  (setq loft4 (entlast))
  (command "_.mirror3d" loft1 "" "XY" "" "")
  (setq loft5 (entlast))
  (command "_.mirror3d" loft2 "" "XY" "" "")
  (setq loft6 (entlast))
  (command "_.mirror3d" loft3 "" "XY" "" "")
  (setq loft7 (entlast))
  (command "_.mirror3d" loft4 "" "XY" "" "")
  (setq loft8 (entlast))
  (setq lofts (ssadd))
  (ssadd loft1 lofts)
  (ssadd loft2 lofts)
  (ssadd loft3 lofts)
  (ssadd loft4 lofts)
  (ssadd loft5 lofts)
  (ssadd loft6 lofts)
  (ssadd loft7 lofts)
  (ssadd loft8 lofts)
  (command "_.surfsculpt" lofts "")
  (entdel sp1)
  (entdel sp2)
  (entdel sp3)
  (entdel sp4)
  (setvar 'osmode osm)
(princ)
)

Regards, M.R.
:)
Hope you'll at least find it somewhat useful... It's all in *.lsp API...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

SEANT

  • Bull Frog
  • Posts: 345
Re: Explode non-uniformly scaled block ?
« Reply #10 on: December 18, 2011, 05:39:19 PM »
I really do not think AutoCAD can make a Degree 2 NURBS surface from the drawing editor.  It seems like Lofting operations always default to Degree 3.

It can be done programmatically – certainly via ObjectARX, both managed and native.  You will have to tell me if it can be done with Autolisp or VisualLisp.   I have virtually no experience there.

That ARX functionality can be exposed to AutoLisp, though. again,  no practical experience. Perhaps one of the locals, with a good background in both APIs, will take up the challenge.  If not, I’ll look into it, but it wouldn’t be until after the holidays.
Sean Tessier
AutoCAD 2016 Mechanical

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Explode non-uniformly scaled block ?
« Reply #11 on: December 18, 2011, 06:21:42 PM »
Here is my last and final code... Now added segmentation of octant with cross sections ellipses... Tested for 36 segments and results for volume are almost exactly correct (less for 0.1%). So now it's only matter how fast - inaccurate/slow - accurate do you want it... Presentation is preserved simple wire like yours ellipsoid, Seant...

Code: [Select]
(defun c:ellipsoid-final ( / A ANGN B CE DXF11 DXF40 EL H K LOFT1 LOFT2 LOFT3 LOFT4 LOFT5 LOFT6 LOFT7 LOFT8 LOFTS NSEG OSM PTST SP1 SP1CV SP1EN SP1ST SP2 SP2CV SP2EN SP2NOR SP2ST SP3 SP3CV SP3EN SP3NOR SP3ST SP4 SPN SPNCV SPNEN SPNNOR SPNST SPSS ST1 ST2 )
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (command "_.UCS" "w")
  (prompt "\nPick center of ellipsoid : ")
  (command "_.ellipse" "c")
  (while (eq 1 (logand 1 (getvar 'cmdactive))) (command pause))
  (setq el (entlast))
  (setq ce (cdr (assoc 10 (entget el))))
  (setq dxf11 (cdr (assoc 11 (entget el))))
  (setq dxf40 (cdr (assoc 40 (entget el))))
  (initget 5)
  (setq h (getdist ce "\nPick height of ellipsoid : "))
  (entdel el)
  (setq ptst (mapcar '+ ce dxf11))
  (setq a (distance ce ptst))
  (setq b (* dxf40 a))
  (setq sp1st ptst)
  (setq sp1en (polar ce (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1cv (polar sp1st (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 sp1st) (cons 41 1.0) (cons 10 sp1cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp1en) (cons 41 1.0)) )))
  (command "_.UCS" "3p" sp1st ce "")
  (command "_.UCS" "x" 90)
  (setq sp2st (trans '(0.0 0.0 0.0) 1 0))
  (setq sp2en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp2cv (trans (list 0.0 h 0.0) 1 0))
  (if (equal (caddr sp2en) (caddr sp2cv) 1e-4) () (setq sp2cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (setq sp2nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
  (setq sp2 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp2nor) (cons 10 sp2st) (cons 41 1.0) (cons 10 sp2cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp2en) (cons 41 1.0)) )))
  (command "_.UCS" "p")
  (command "_.UCS" "p")
  (command "_.UCS" "3p" sp1en ce "")
  (command "_.UCS" "x" 90)
  (setq sp3st (trans '(0.0 0.0 0.0) 1 0))
  (setq sp3en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp3cv (trans (list 0.0 h 0.0) 1 0))
  (if (equal (caddr sp3en) (caddr sp3cv) 1e-4) () (setq sp3cv (trans (list 0.0 (- h) 0.0) 1 0)))
  (setq sp3nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
  (setq sp3 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp3nor) (cons 10 sp3st) (cons 41 1.0) (cons 10 sp3cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp3en) (cons 41 1.0)) )))
  (command "_.UCS" "p")
  (command "_.UCS" "p")
  (initget 5)
  (setq nseg (getint "\nEnter number of segments for segmentation ellipsoid octant (bigger no. more accurate, but slower) : "))
  (setq angn (/ (/ PI 2.0) nseg))
  (setq k 0)
  (setq spss (ssadd))
  (ssadd sp2 spss)
  (repeat (- nseg 1)
    (setq k (1+ k))
    (setq spnst (polar (polar sp2st (angle ce sp3st) (* b (sin (* k angn)))) (angle sp2st ce) (* a (- 1 (cos (* k angn))))))
    (setq spnen (mapcar '+ ce (list 0.0 0.0 h)))
    (command "_.UCS" "3p" spnst ce "")
    (command "_.UCS" "x" 90)
    (setq spncv (trans (list 0.0 h 0.0) 1 0))
    (if (equal (caddr spnen) (caddr spncv) 1e-4) () (setq spncv (trans (list 0.0 (- h) 0.0) 1 0)))
    (setq spnnor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
    (setq spn (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 spnnor) (cons 10 spnst) (cons 41 1.0) (cons 10 spncv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 spnen) (cons 41 1.0)) )))
    (command "_.UCS" "p")
    (command "_.UCS" "p")
    (ssadd spn spss)
  )
  (ssadd sp3 spss)
  (initget 5)
  (setq st1 (getint "\nEnter surfu value : "))
  (initget 5)
  (setq st2 (getint "\nEnter surfv value : "))
  (setvar 'surfu st1)
  (setvar 'surfv st2)
  (command "_.loft" spss "" "g" sp1 "")
  (setq loft1 (entlast))
  (command "_.mirror" loft1 "" ce sp1st "")
  (setq loft2 (entlast))
  (command "_.mirror" loft1 "" ce sp1en "")
  (setq loft3 (entlast))
  (command "_.mirror" loft2 "" ce sp1en "")
  (setq loft4 (entlast))
  (command "_.mirror3d" loft1 "" "XY" "" "")
  (setq loft5 (entlast))
  (command "_.mirror3d" loft2 "" "XY" "" "")
  (setq loft6 (entlast))
  (command "_.mirror3d" loft3 "" "XY" "" "")
  (setq loft7 (entlast))
  (command "_.mirror3d" loft4 "" "XY" "" "")
  (setq loft8 (entlast))
  (setq lofts (ssadd))
  (ssadd loft1 lofts)
  (ssadd loft2 lofts)
  (ssadd loft3 lofts)
  (ssadd loft4 lofts)
  (ssadd loft5 lofts)
  (ssadd loft6 lofts)
  (ssadd loft7 lofts)
  (ssadd loft8 lofts)
  (command "_.surfsculpt" lofts "")
  (entdel sp1)
  (entdel sp2)
  (entdel sp3)
  (command "_.erase" spss "")
  (setvar 'osmode osm)
(princ)
)

Regards, M.R.
 8-)
:beer:
« Last Edit: December 19, 2011, 03:54:24 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

SEANT

  • Bull Frog
  • Posts: 345
Re: Explode non-uniformly scaled block ?
« Reply #12 on: December 18, 2011, 06:26:34 PM »
Nicely done.   8-)
Sean Tessier
AutoCAD 2016 Mechanical

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Explode non-uniformly scaled block ?
« Reply #13 on: December 19, 2011, 05:41:43 AM »
Even more optimized not to use UCS transformations, witch fastens execution of routine...

Code: [Select]

; transptucs & transptwcs by M.R. (Marko Ribar, d.i.a.)
; arguments :
; pt - point to be transformed from WCS to imaginary UCS with transptucs and from imaginary UCS to WCS with transptwcs
; pt1 - origin of imaginary UCS
; pt2 - point to define X axis of imaginary UCS (vector pt1-pt2 represents X axis)
; pt3 - point to define Y axis of imaginary UCS (vector pt1-pt3 represents Y axis)
; important note : angle between X and Y axises of imaginary UCS must always be 90 degree for correct transformation calculation

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
  (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Vector Norm - Lee Mac
;; Args: v - vector in R^n

(defun norm ( v )
  (sqrt (apply '+ (mapcar '* v v)))
)

;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
  (mapcar '(lambda ( n ) (* n s)) v)
)

;; Unit Vector - Lee Mac
;; Args: v - vector in R^n

(defun unit ( v )
  ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
)

;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
  (list
    (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
    (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
    (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  )
)

(defun transptucs ( pt p1 p2 p3 / ux uy uz )
  (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
  (setq ux (unit (mapcar '- p2 p1)))
  (setq uy (unit (mapcar '- p3 p1)))
 
  (mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
  (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
  (transptucs pt pt1n pt2n pt3n)
)

(defun c:ellipsoid-final ( / A ANGN B CE DXF11 DXF40 EL H K LOFT1 LOFT2 LOFT3 LOFT4 LOFT5 LOFT6 LOFT7 LOFT8 LOFTS NSEG OSM PTST SP1 SP1CV SP1EN SP1ST SP2 SP2CV SP2EN SP2NOR SP2ST SP3 SP3CV SP3EN SP3NOR SP3ST SPN SPNCV SPNEN SPNNOR SPNST SPSS ST1 ST2 )
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (command "_.UCS" "w")
  (prompt "\nPick center of ellipsoid : ")
  (command "_.ellipse" "c")
  (while (eq 1 (logand 1 (getvar 'cmdactive))) (command pause))
  (setq el (entlast))
  (setq ce (cdr (assoc 10 (entget el))))
  (setq dxf11 (cdr (assoc 11 (entget el))))
  (setq dxf40 (cdr (assoc 40 (entget el))))
  (initget 5)
  (setq h (getdist ce "\nPick height of ellipsoid : "))
  (entdel el)
  (setq ptst (mapcar '+ ce dxf11))
  (setq a (distance ce ptst))
  (setq b (* dxf40 a))
  (setq sp1st ptst)
  (setq sp1en (polar ce (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1cv (polar sp1st (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
  (setq sp1 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 sp1st) (cons 41 1.0) (cons 10 sp1cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp1en) (cons 41 1.0)) )))
  (setq sp2st sp1st)
  (setq sp2en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp2cv (transptwcs (list 0.0 h 0.0) sp2st ce (mapcar '+ sp2st '(0.0 0.0 1.0))))
  (if (equal (caddr sp2en) (caddr sp2cv) 1e-4) () (setq sp2cv (transptwcs (list 0.0 (- h) 0.0) sp2st ce (mapcar '+ sp2st '(0.0 0.0 1.0)))))
  (setq sp2nor (mapcar '- (transptwcs (list 0.0 0.0 1.0) sp2st ce (mapcar '+ sp2st '(0.0 0.0 1.0))) (transptwcs (list 0.0 0.0 0.0) sp2st ce (mapcar '+ sp2st '(0.0 0.0 1.0)))))
  (setq sp2 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp2nor) (cons 10 sp2st) (cons 41 1.0) (cons 10 sp2cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp2en) (cons 41 1.0)) )))
  (setq sp3st sp1en)
  (setq sp3en (mapcar '+ ce (list 0.0 0.0 h)))
  (setq sp3cv (transptwcs (list 0.0 h 0.0) sp3st ce (mapcar '+ sp3st '(0.0 0.0 1.0))))
  (if (equal (caddr sp3en) (caddr sp3cv) 1e-4) () (setq sp3cv (transptwcs (list 0.0 (- h) 0.0) sp3st ce (mapcar '+ sp3st '(0.0 0.0 1.0)))))
  (setq sp3nor (mapcar '- (transptwcs (list 0.0 0.0 1.0) sp3st ce (mapcar '+ sp3st '(0.0 0.0 1.0))) (transptwcs (list 0.0 0.0 0.0) sp3st ce (mapcar '+ sp3st '(0.0 0.0 1.0)))))
  (setq sp3 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp3nor) (cons 10 sp3st) (cons 41 1.0) (cons 10 sp3cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp3en) (cons 41 1.0)) )))
  (initget 5)
  (setq nseg (getint "\nEnter number of segments for segmentation ellipsoid octant (bigger no. more accurate, but slower) : "))
  (setq angn (/ (/ PI 2.0) nseg))
  (setq k 0)
  (setq spss (ssadd))
  (ssadd sp2 spss)
  (repeat (- nseg 1)
    (setq k (1+ k))
    (setq spnst (polar (polar sp2st (angle ce sp3st) (* b (sin (* k angn)))) (angle sp2st ce) (* a (- 1 (cos (* k angn))))))
    (setq spnen (mapcar '+ ce (list 0.0 0.0 h)))
    (setq spncv (transptwcs (list 0.0 h 0.0) spnst ce (mapcar '+ spnst '(0.0 0.0 1.0))))
    (if (equal (caddr spnen) (caddr spncv) 1e-4) () (setq spncv (transptwcs (list 0.0 (- h) 0.0) spnst ce (mapcar '+ spnst '(0.0 0.0 1.0)))))
    (setq spnnor (mapcar '- (transptwcs (list 0.0 0.0 1.0) spnst ce (mapcar '+ spnst '(0.0 0.0 1.0))) (transptwcs (list 0.0 0.0 0.0) spnst ce (mapcar '+ spnst '(0.0 0.0 1.0)))))
    (setq spn (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 spnnor) (cons 10 spnst) (cons 41 1.0) (cons 10 spncv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 spnen) (cons 41 1.0)) )))
    (ssadd spn spss)
  )
  (ssadd sp3 spss)
  (initget 5)
  (setq st1 (getint "\nEnter surfu value : "))
  (initget 5)
  (setq st2 (getint "\nEnter surfv value : "))
  (setvar 'surfu st1)
  (setvar 'surfv st2)
  (command "_.loft" spss "" "g" sp1 "")
  (setq loft1 (entlast))
  (command "_.mirror" loft1 "" ce sp1st "")
  (setq loft2 (entlast))
  (command "_.mirror" loft1 "" ce sp1en "")
  (setq loft3 (entlast))
  (command "_.mirror" loft2 "" ce sp1en "")
  (setq loft4 (entlast))
  (command "_.mirror3d" loft1 "" "XY" "" "")
  (setq loft5 (entlast))
  (command "_.mirror3d" loft2 "" "XY" "" "")
  (setq loft6 (entlast))
  (command "_.mirror3d" loft3 "" "XY" "" "")
  (setq loft7 (entlast))
  (command "_.mirror3d" loft4 "" "XY" "" "")
  (setq loft8 (entlast))
  (setq lofts (ssadd))
  (ssadd loft1 lofts)
  (ssadd loft2 lofts)
  (ssadd loft3 lofts)
  (ssadd loft4 lofts)
  (ssadd loft5 lofts)
  (ssadd loft6 lofts)
  (ssadd loft7 lofts)
  (ssadd loft8 lofts)
  (command "_.surfsculpt" lofts "")
  (entdel sp1)
  (entdel sp2)
  (entdel sp3)
  (command "_.erase" spss "")
  (setvar 'osmode osm)
(princ)
)

And in various 3d positions with transformed UCS :

Code: [Select]

; transptucs & transptwcs by M.R. (Marko Ribar, d.i.a.)
; arguments :
; pt - point to be transformed from WCS to imaginary UCS with transptucs and from imaginary UCS to WCS with transptwcs
; pt1 - origin of imaginary UCS
; pt2 - point to define X axis of imaginary UCS (vector pt1-pt2 represents X axis)
; pt3 - point to define Y axis of imaginary UCS (vector pt1-pt3 represents Y axis)
; important note : angle between X and Y axises of imaginary UCS must always be 90 degree for correct transformation calculation

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
  (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Vector Norm - Lee Mac
;; Args: v - vector in R^n

(defun norm ( v )
  (sqrt (apply '+ (mapcar '* v v)))
)

;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
  (mapcar '(lambda ( n ) (* n s)) v)
)

;; Unit Vector - Lee Mac
;; Args: v - vector in R^n

(defun unit ( v )
  ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
)

;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
  (list
    (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
    (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
    (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  )
)

(defun transptucs ( pt p1 p2 p3 / ux uy uz )
  (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
  (setq ux (unit (mapcar '- p2 p1)))
  (setq uy (unit (mapcar '- p3 p1)))
 
  (mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
  (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
  (transptucs pt pt1n pt2n pt3n)
)

(defun c:ellipsoid-final ( / A ANGN B CE DXF11 DXF40 EL H K LOFT1 LOFT2 LOFT3 LOFT4 LOFT5 LOFT6 LOFT7 LOFT8 LOFTS NSEG OSM PTST SP1 SP1CV SP1EN SP1ST SP2 SP2CV SP2EN SP2NOR SP2ST SP3 SP3CV SP3EN SP3NOR SP3ST SPN SPNCV SPNEN SPNNOR SPNST SPSS ST1 ST2 SURFT )
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (prompt "\nPick center of ellipsoid : ")
  (command "_.ellipse" "c")
  (while (eq 1 (logand 1 (getvar 'cmdactive))) (command pause))
  (setq el (entlast))
  (setq ce (cdr (assoc 10 (entget el))))
  (setq dxf11 (cdr (assoc 11 (entget el))))
  (setq dxf40 (cdr (assoc 40 (entget el))))
  (initget 5)
  (setq h (getdist (trans ce 0 1) "\nPick height of ellipsoid : "))
  (entdel el)
  (setq ptst (mapcar '+ ce dxf11))
  (setq a (distance ce ptst))
  (setq b (* dxf40 a))
  (setq ce (trans ce 0 1))
  (setq sp1st ptst)
  (setq sp1en (trans (polar ce (+ (angle (trans ptst 0 1) ce) (/ PI 2.0)) b) 1 0))
  (setq sp1cv (trans (polar (trans ptst 0 1) (+ (angle (trans ptst 0 1) ce) (/ PI 2.0)) b) 1 0))
  (setq sp1 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 sp1st) (cons 41 1.0) (cons 10 sp1cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp1en) (cons 41 1.0)) )))
  (setq sp2st sp1st)
  (setq sp2en (trans (mapcar '+ ce (list 0.0 0.0 h)) 1 0))
  (setq sp2cv (trans (mapcar '+ (trans sp2st 0 1) (list 0.0 0.0 h)) 1 0))
  (setq sp2nor (mapcar '- (transptwcs (list 0.0 0.0 1.0) sp2st (trans ce 1 0) sp2cv) (transptwcs (list 0.0 0.0 0.0) sp2st (trans ce 1 0) sp2cv)))
  (setq sp2 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp2nor) (cons 10 sp2st) (cons 41 1.0) (cons 10 sp2cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp2en) (cons 41 1.0)) )))
  (setq sp3st sp1en)
  (setq sp3en (trans (mapcar '+ ce (list 0.0 0.0 h)) 1 0))
  (setq sp3cv (trans (mapcar '+ (trans sp3st 0 1) (list 0.0 0.0 h)) 1 0))
  (setq sp3nor (mapcar '- (transptwcs (list 0.0 0.0 1.0) sp3st (trans ce 1 0) sp3cv) (transptwcs (list 0.0 0.0 0.0) sp3st (trans ce 1 0) sp3cv)))
  (setq sp3 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 sp3nor) (cons 10 sp3st) (cons 41 1.0) (cons 10 sp3cv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 sp3en) (cons 41 1.0)) )))
  (initget 5)
  (setq nseg (getint "\nEnter number of segments for segmentation ellipsoid octant (bigger no. more accurate, but slower) : "))
  (setq angn (/ (/ PI 2.0) nseg))
  (setq k 0)
  (setq spss (ssadd))
  (ssadd sp2 spss)
  (repeat (- nseg 1)
    (setq k (1+ k))
    (setq spnst (trans (polar (polar (trans sp2st 0 1) (angle ce (trans sp3st 0 1)) (* b (sin (* k angn)))) (angle (trans sp2st 0 1) ce) (* a (- 1 (cos (* k angn))))) 1 0))
    (setq spnen (trans (mapcar '+ ce (list 0.0 0.0 h)) 1 0))
    (setq spncv (trans (mapcar '+ (trans spnst 0 1) (list 0.0 0.0 h)) 1 0))
    (setq spnnor (mapcar '- (transptwcs (list 0.0 0.0 1.0) spnst (trans ce 1 0) spncv) (transptwcs (list 0.0 0.0 0.0) spnst (trans ce 1 0) spncv)))
    (setq spn (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 210 spnnor) (cons 10 spnst) (cons 41 1.0) (cons 10 spncv) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 spnen) (cons 41 1.0)) )))
    (ssadd spn spss)
  )
  (ssadd sp3 spss)
  (initget 5)
  (setq st1 (getint "\nEnter surfu value : "))
  (initget 5)
  (setq st2 (getint "\nEnter surfv value : "))
  (setvar 'surfu st1)
  (setvar 'surfv st2)
  (setq surft (getvar 'surftype))
  (setvar 'surftype 5)
  (command "_.loft" spss "" "g" sp1 "")
  (setvar 'surftype surft)
  (setq loft1 (entlast))
  (command "_.mirror" loft1 "" ce (trans sp1st 0 1) "")
  (setq loft2 (entlast))
  (command "_.mirror" loft1 "" ce (trans sp1en 0 1) "")
  (setq loft3 (entlast))
  (command "_.mirror" loft2 "" ce (trans sp1en 0 1) "")
  (setq loft4 (entlast))
  (command "_.mirror3d" loft1 "" "XY" "" "")
  (setq loft5 (entlast))
  (command "_.mirror3d" loft2 "" "XY" "" "")
  (setq loft6 (entlast))
  (command "_.mirror3d" loft3 "" "XY" "" "")
  (setq loft7 (entlast))
  (command "_.mirror3d" loft4 "" "XY" "" "")
  (setq loft8 (entlast))
  (setq lofts (ssadd))
  (ssadd loft1 lofts)
  (ssadd loft2 lofts)
  (ssadd loft3 lofts)
  (ssadd loft4 lofts)
  (ssadd loft5 lofts)
  (ssadd loft6 lofts)
  (ssadd loft7 lofts)
  (ssadd loft8 lofts)
  (command "_.surfsculpt" lofts "")
  (entdel sp1)
  (entdel sp2)
  (entdel sp3)
  (command "_.erase" spss "")
  (setvar 'osmode osm)
(princ)
)

M.R. 8-) 8-) 8-)
« Last Edit: December 31, 2011, 12:14:40 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Explode non-uniformly scaled block ?
« Reply #14 on: December 23, 2011, 03:23:40 AM »
I hope Seant won't be mad at me... I decided to post his work with mine. For exactly perfect ellipsoid, I suggest his C# routines. It creates ellipsoid at WCS basepoint (0, 0, 0), but volume is almost perfect... For those that just want to use it, start ACAD 2012 x64 (didn't checked on x32 version), start command NETLOAD and select desired *.dll... Command for execution are the same as *.dll file name...

Regards, M.R.
:)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube