Author Topic: 3D to 3D visuelisation - GENERIC AXONOMETRY  (Read 4139 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
3D to 3D visuelisation - GENERIC AXONOMETRY
« on: June 11, 2012, 08:10:58 AM »
Hi all folks,

Recently I played with my old routines for 3d to 3d visualisation (3d model in catesian system => 3d generic axonometry in xOy plane view... Of course, transformation is done with 3d distorsion of model, but viewed from "top" view with hide or shademode variants of AutoCAD transformation is correct... Now I added posibility of orbiting while using parameters of generic axonometry and rotation of model with (grread) function... It still behaves slow with too complex models (pfmesh objects), so I decided to transform each pfmesh one by one alowing in the end to be transformed whole model with chosen axonometry - STRONGLY RECOMMENDED THAT YOUR MODEL HAS AS LESS AS POSSIBLE POINTS PER PFMESH 3D OBJECT... Note : as I described in my old post on AUGI, for all of this you have to have possibility to convert CAD 3D model (probably 3DSOLID geometry) to polyface meshes geometry... I use for this Autodesk 3DS MAX (import from CAD - DWG) => (export to DWG 2000 file format) and then I open model in CAD - you have to correct Layer colors after this to match original, for MAX import gives different colors than CAD original model... So here is my precious code I decided to share :

[EDIT: If you have an option in CAD - CONVTOMESH command, you can apply this routine to these kind of objects also without need to jump to 3ds max]

Code - Auto/Visual Lisp: [Select]
  1.  
  2. ;; LM:Flatten
  3. ;; Flattens list (frees from brackets inside list)
  4. ;;
  5. ;; Atgument : a list
  6.  
  7. (defun LM:Flatten ( lst )
  8.   (if (atom lst) (list lst)
  9.     (append (LM:Flatten (car lst)) (if (cdr lst) (LM:Flatten (cdr lst))))
  10.   )
  11. )
  12.  
  13. ;; MXV
  14. ;; Applies a transformation matrix to a vector -Vladimir Nesterovsky-
  15. ;;
  16. ;; Arguments : a matrix and a vector
  17.  
  18. (defun mxv (m v)
  19.   (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
  20. )
  21.  
  22. (defun v^v ( u v )
  23.   (list
  24.     (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
  25.     (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
  26.     (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  27.   )
  28. )
  29.  
  30. (defun unit ( v / dv )
  31.   (setq dv (distance '(0.0 0.0 0.0) v))
  32.   (mapcar '(lambda ( x ) (/ x dv)) v)
  33. )
  34.  
  35. (defun c:pfm-orbit ( / CH1 ANGX ANGXR KX ANGY ANGYR KY ANGZ ANGZR KZ ANGR EACOORDLST EACOORDVAR EAENTPFM EANCOORDVAR ENTLST ENTN ENTPFM GR K LOOP M MATRIX MPT N P PT PTLISTA PTLISTAN PTLISTANN PTNEW QAF RM SFA SS SSASHADE SSBLKS SSCOL SSL SSLEN XDIR YDIR ZDIR)
  36.  
  37. (if (/= (tblsearch "layer" "ASHADE") nil)
  38. (command "-layer" "U" "ASHADE" "")
  39. (setq ssashade (ssget "_X" (list (cons 8 "ASHADE"))))
  40. (if (/= ssashade nil)
  41. (setq ssl (sslength ssashade))
  42. (setq k -1)
  43. (repeat ssl
  44. (setq k (+ k 1))
  45. (setq entn (ssname ssashade k))
  46. (entdel entn)
  47. )
  48. ))
  49. (command "-purge" "All" "" "N" "")
  50. ))
  51. (setq ssblks (ssget "_X" (list (cons 0 "INSERT"))))
  52. (if (/= ssblks nil)
  53. (setq qaf (getvar 'qaflags))
  54. (setvar 'qaflags 1)
  55. (command "_.explode" ssblks "")
  56. (setvar 'qaflags qaf)
  57. (command "-purge" "All" "" "N" "")
  58. ))
  59. (setq sscol (ssget "_X" (list (cons 62 0))))
  60. (if (/= sscol nil)
  61. (command "change" sscol "" "p" "c" "bylayer" "" "")
  62. )
  63.   (command "_.UCS" "w")
  64.   (command "_.plan" "")
  65.   (command "_.zoom" "0.5x")
  66.   (setq rm (getvar 'regenmode))
  67.   (setvar 'regenmode 0)
  68.   (setq angx (getreal "\nInput angle of x projection axis (angle must be between 0 and 360) : "))
  69.   (setq angxr (* (/ angx 180) PI))
  70.   (setq kx (getreal "\nInput coeficient of scaling along x projection axis (1 - no scaling) : "))
  71.   (setq angy (getreal "\nInput angle of y projection axis (angle must be between 0 and 360) : "))
  72.   (setq angyr (* (/ angy 180) PI))
  73.   (setq ky (getreal "\nInput coeficient of scaling along y projection axis (1 - no scaling) : "))
  74.   (setq angz (getreal "\nInput angle of z projection axis (angle must be between 0 and 360) : "))
  75.   (setq angzr (* (/ angz 180) PI))
  76.   (setq kz (getreal "\nInput coeficient of scaling along z projection axis (1 - no scaling) : "))
  77.   (if (not ch2) (setq ch2 "No"))
  78.   (setq n -1)
  79.   (setq entlst (list (cons 0 "POLYLINE,MESH")))
  80.   (setq ss (ssget "_X" entlst))
  81.   (setq sslen (sslength ss))
  82.   (while (and (eq ch2 "No") (< (setq n (+ n 1)) sslen))
  83.     (setq ptlista nil)
  84.     (setq ptlistan nil)
  85.     (setq ptlistann nil)
  86.     (setq entpfm (ssname ss n))
  87.     (setq EAentpfm (vlax-ename->vla-object entpfm))
  88.     (setq EAcoordvar (vla-get-Coordinates EAentpfm))
  89.     (setq EAcoordlst (vlax-safearray->list (vlax-variant-value EAcoordvar)))
  90.     (setq m (length EAcoordlst))
  91.     (setq mpt (/ m 3))
  92.     (prompt "\nLeft click with mouse to proceed or any key to start over")
  93.     (setq loop T)
  94.     (while loop
  95.       (setq gr (grread T 15 0))
  96.       (if (eq (car gr) 5)
  97.         (progn
  98.           (setq p (cadr gr))
  99.           (setq angr (angle '(0.0 0.0 0.0) p))
  100.           (setq xdir (polar '(0.0 0.0 0.0) angr 1.0))
  101.           (setq ydir (polar '(0.0 0.0 0.0) (+ angr (/ pi 2.0)) 1.0))
  102.           (setq zdir (unit (v^v xdir ydir)))
  103.           (if (not ptlista)
  104.             (progn
  105.               (repeat mpt
  106.                 (setq pt (list (car EAcoordlst) (cadr EAcoordlst) (caddr EAcoordlst)))
  107.                 (setq EAcoordlst (cdddr EAcoordlst))
  108.                 (setq ptlista (cons pt ptlista))
  109.               )
  110.               (setq ptlista (reverse ptlista))
  111.             )
  112.           )
  113.           (setq matrix (list
  114.                          (list (car xdir) (car ydir) (car zdir))
  115.                          (list (cadr xdir) (cadr ydir) (cadr zdir))
  116.                          (list (caddr xdir) (caddr ydir) (caddr zdir))
  117.                        )
  118.           )
  119.           (if (not ptlistan)
  120.             (setq ptlistan (mapcar '(lambda (x) (mxv matrix x)) ptlista))
  121.           )
  122.           (foreach pt ptlistan
  123.             (setq ptnew
  124.               (list (+ (car (polar (list 0 0 0) angxr (* kx (car pt))))
  125.                     (car (polar (list 0 0 0) angyr (* ky (cadr pt))))
  126.                     (car (polar (list 0 0 0) angzr (* kz (caddr pt)))) )
  127.  
  128.                     (+ (cadr (polar (list 0 0 0) angxr (* kx (car pt))))
  129.                     (cadr (polar (list 0 0 0) angyr (* ky (cadr pt))))
  130.                     (cadr (polar (list 0 0 0) angzr (* kz (caddr pt)))) )
  131.  
  132.                    (caddr pt)
  133.               )
  134.             )
  135.             (setq ptlistann (cons ptnew ptlistann))
  136.           )
  137.           (setq ptlistann (reverse ptlistann))
  138.           (if ptlistann
  139.             (progn
  140.               (setq ptlistann (LM:Flatten ptlistann))
  141.               (setq sfa (vlax-make-safearray vlax-vbdouble (cons 1 m)))
  142.               (vlax-safearray-fill sfa ptlistann)
  143.               (setq EANcoordvar (vlax-make-variant sfa))
  144.               (vla-put-Coordinates EAentpfm EANcoordvar)
  145.               (vla-update EAentpfm)
  146.               (setq ptlistan nil)
  147.               (setq ptlistann nil)
  148.             )
  149.           )
  150.         )
  151.       )
  152.       (if (eq (car gr) 2)
  153.         (progn
  154.           (vla-put-Coordinates EAentpfm EAcoordvar)
  155.           (vla-update EAentpfm)
  156.           (setq loop nil)
  157.           (c:pfm-orbit)
  158.         )
  159.       )
  160.       (if (eq (car gr) 3)
  161.         (progn
  162.           (initget 1 "Yes No")
  163.           (setq ch1 (getkword "\nDo you want to keep position or to restore to start (Yes/No) : "))
  164.           (if (eq ch1 "Yes")
  165.             (progn
  166.               (initget 1 "Yes No")
  167.               (setq ch2 (getkword "\nDo you want to keep position to all pfmeshes (Yes/No) : "))
  168.               (if (eq ch2 "Yes")
  169.                 (progn
  170.                   (vla-put-Coordinates EAentpfm EAcoordvar)
  171.                   (vla-update EAentpfm)
  172.                   (setq n -1)
  173.                   (setq entlst (list (cons 0 "POLYLINE,MESH")))
  174.                   (setq ss (ssget "_X" entlst))
  175.                   (setq sslen (sslength ss))
  176.                   (repeat sslen
  177.                     (setq ptlista nil)
  178.                     (setq ptlistan nil)
  179.                     (setq ptlistann nil)
  180.                     (setq n (+ n 1))
  181.                     (setq entpfm (ssname ss n))
  182.                     (setq EAentpfm (vlax-ename->vla-object entpfm))
  183.                     (setq EAcoordvar (vla-get-Coordinates EAentpfm))
  184.                     (setq EAcoordlst (vlax-safearray->list (vlax-variant-value EAcoordvar)))
  185.                     (setq m (length EAcoordlst))
  186.                     (setq mpt (/ m 3))
  187.                     (repeat mpt
  188.                       (setq pt (list (car EAcoordlst) (cadr EAcoordlst) (caddr EAcoordlst)))
  189.                       (setq EAcoordlst (cdddr EAcoordlst))
  190.                       (setq ptlista (cons pt ptlista))
  191.                     )
  192.                     (setq ptlista (reverse ptlista))
  193.                     (if (not ptlistan)
  194.                       (setq ptlistan (mapcar '(lambda (x) (mxv matrix x)) ptlista))
  195.                     )
  196.                     (foreach pt ptlistan
  197.                       (setq ptnew
  198.                         (list (+ (car (polar (list 0 0 0) angxr (* kx (car pt))))
  199.                               (car (polar (list 0 0 0) angyr (* ky (cadr pt))))
  200.                               (car (polar (list 0 0 0) angzr (* kz (caddr pt)))) )
  201.  
  202.                               (+ (cadr (polar (list 0 0 0) angxr (* kx (car pt))))
  203.                               (cadr (polar (list 0 0 0) angyr (* ky (cadr pt))))
  204.                               (cadr (polar (list 0 0 0) angzr (* kz (caddr pt)))) )
  205.  
  206.                               (caddr pt)
  207.                         )
  208.                       )
  209.                       (setq ptlistann (cons ptnew ptlistann))
  210.                     )
  211.                     (setq ptlistann (reverse ptlistann))
  212.                     (if ptlistann
  213.                       (progn
  214.                         (setq ptlistann (LM:Flatten ptlistann))
  215.                         (setq sfa (vlax-make-safearray vlax-vbdouble (cons 1 m)))
  216.                         (vlax-safearray-fill sfa ptlistann)
  217.                         (setq EANcoordvar (vlax-make-variant sfa))
  218.                         (vla-put-Coordinates EAentpfm EANcoordvar)
  219.                         (vla-update EAentpfm)
  220.                         (setq ptlistan nil)
  221.                         (setq ptlistann nil)
  222.                       )
  223.                     )
  224.                   )
  225.                   (setq loop nil)
  226.                 )
  227.                 (setq loop nil)
  228.               )
  229.             )
  230.             (progn
  231.               (vla-put-Coordinates EAentpfm EAcoordvar)
  232.               (vla-update EAentpfm)
  233.               (setq loop nil)
  234.             )
  235.           )
  236.         )
  237.       )
  238.     )
  239.   )
  240.   (setvar 'regenmode rm)
  241.   (setq ch2 nil)
  242.   (princ)
  243. )
  244.  

Regards, M.R.
Hope this will be useful for architects like it is for me...

[EDIT : CODE UPDATED TO SUPPORT MESH ENTITIES - NOT JUST (PFMESHES - POLYLINE), SO POSTED LISP ISN'T QUITE CORRECT - COPY+PASTE CODE THAT WAS POSTED ABOVE]
« Last Edit: January 23, 2014, 08:39:51 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube