Author Topic: POINT on NURBS surface  (Read 1720 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
POINT on NURBS surface
« on: March 26, 2019, 06:28:33 AM »
Hi guys...

I need some help/advice... I want to acquire one point data (coordinates) of point that lie on NURBS surface... I don't want to use IMPRINT or something like that, I just need this as fast as possible - so no sending rays of lines for checking... Only one single point on surface is all that I want, and please with LISP (no VB(A), C, C++, C#)...

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

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: POINT on NURBS surface
« Reply #1 on: March 26, 2019, 08:16:02 AM »
Not 100% sure about reliability, but according to my testings, it should work... If someone has some suggestion, I am open to hear it, thanks...

Code - Auto/Visual Lisp: [Select]
  1. (defun pointsonnurbs ( nurbs / ucsf ll ur surf el elx pl )
  2.  
  3.  
  4.   (if (= 0 (getvar 'worlducs))
  5.     (progn
  6.       (setq ucsf t)
  7.       (vl-cmdf "_.UCS" "_W")
  8.     )
  9.   )
  10.   (vla-getboundingbox (vlax-ename->vla-object nurbs) 'll 'ur)
  11.   (mapcar 'set '(ll ur) (mapcar 'safearray-value (list ll ur)))
  12.   (vl-cmdf "_.BOX" "_non" ll "_non" ur)
  13.   (vl-cmdf "_.CONVTOSURFACE" "_L" "")
  14.   (setq surf (entlast))
  15.   (setq el (entlast))
  16.   (vl-cmdf "_.INTERSECT" surf nurbs "")
  17.   (if (and (not (entget surf)) (not (entget nurbs)))
  18.     (while (setq el (entnext el))
  19.       (if (= (cdr (assoc 0 (setq elx (entget el)))) "POINT")
  20.         (setq pl (cons (cdr (assoc 10 elx)) pl))
  21.       )
  22.     )
  23.   )
  24.   (vl-cmdf "_.UNDO" "1")
  25.   (if (and (entget surf) (entget nurbs))
  26.     (entdel surf)
  27.   )
  28.   (if ucsf
  29.     (vl-cmdf "_.UCS" "_P")
  30.   )
  31.   pl
  32. )
  33.  

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

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: POINT on NURBS surface
« Reply #2 on: March 26, 2019, 09:42:35 AM »
I've rechecked it and now it fails to get at least 1 point... Situation is that NURBS is planar and parallel to either WCS plane or FRONT, LEFT, RIGHT, BACK, TOP, BOTTOM of WCS - NURBS is RECTANGULAR shape... So I need more opinions and revision of code, thanks...

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

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: POINT on NURBS surface
« Reply #3 on: March 26, 2019, 11:25:01 AM »
I figured out, but what is more important my main function works with this sub...

Code - Auto/Visual Lisp: [Select]
  1. (defun pointsonnurbs ( nurbs / ucsf ll ur surf el elx pl rec pll ell eell )
  2.  
  3.  
  4.   (if (= 0 (getvar 'worlducs))
  5.     (progn
  6.       (setq ucsf t)
  7.       (vl-cmdf "_.UCS" "_W")
  8.     )
  9.   )
  10.   (vla-getboundingbox (vlax-ename->vla-object nurbs) 'll 'ur)
  11.   (mapcar 'set '(ll ur) (mapcar 'safearray-value (list ll ur)))
  12.   (if (and (not (equal (car ll) (car ur) 1e-6)) (not (equal (cadr ll) (cadr ur) 1e-6)) (not (equal (caddr ll) (caddr ur) 1e-6)))
  13.     (progn
  14.       (vl-cmdf "_.BOX" "_non" ll "_non" ur)
  15.       (vl-cmdf "_.CONVTOSURFACE" "_L" "")
  16.       (setq surf (entlast))
  17.     )
  18.     (progn
  19.       (cond
  20.         ( (equal (car ll) (car ur) 1e-6)
  21.           (vl-cmdf "_.UCS" "_RIGHT")
  22.           (vl-cmdf "_.RECTANGLE" "_non" (trans ll 0 1) "_non" (trans ur 0 1))
  23.           (vl-cmdf "_.UCS" "_P")
  24.         )
  25.         ( (equal (cadr ll) (cadr ur) 1e-6)
  26.           (vl-cmdf "_.UCS" "_FRONT")
  27.           (vl-cmdf "_.RECTANGLE" "_non" (trans ll 0 1) "_non" (trans ur 0 1))
  28.           (vl-cmdf "_.UCS" "_P")
  29.         )
  30.         ( (equal (caddr ll) (caddr ur) 1e-6)
  31.           (vl-cmdf "_.RECTANGLE" "_non" (trans ll 0 1) "_non" (trans ur 0 1))
  32.         )
  33.       )
  34.       (setq rec (entlast))
  35.     )
  36.   )
  37.   (setq el (entlast))
  38.   (cond
  39.     ( (eq el rec)
  40.       (vl-cmdf "_.EXPLODE" nurbs)
  41.       (while (< 0 (getvar 'cmdactive))
  42.         (vl-cmdf "")
  43.       )
  44.       (setq pll (vlax-invoke (vlax-ename->vla-object (setq el (ssname (ssget "_P") 0))) 'intersectwith (vlax-ename->vla-object rec) acextendnone))
  45.       (if pll
  46.         (repeat (/ (length pll) 3)
  47.           (setq pl (cons (list (car pll) (cadr pll) (caddr pll)) pl))
  48.           (setq pll (cdddr pll))
  49.         )
  50.       )
  51.       (if (null pl)
  52.         (setq pl (cons (vlax-curve-getstartpoint el) pl))
  53.       )
  54.       (vl-cmdf "_.UNDO" "1")
  55.       (entdel rec)
  56.     )
  57.     ( t
  58.       (vl-cmdf "_.INTERSECT" surf nurbs "")
  59.       (if (and (not (entget surf)) (not (entget nurbs)))
  60.         (while (setq el (entnext el))
  61.           (if (= (cdr (assoc 0 (setq elx (entget el)))) "POINT")
  62.             (setq pl (cons (cdr (assoc 10 elx)) pl))
  63.           )
  64.         )
  65.       )
  66.       (vl-cmdf "_.UNDO" "1")
  67.       (if (null pl)
  68.         (progn
  69.           (vl-cmdf "_.EXPLODE" nurbs)
  70.           (while (< 0 (getvar 'cmdactive))
  71.             (vl-cmdf "")
  72.           )
  73.           (setq ell (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P")))))
  74.           (vl-cmdf "_.EXPLODE" surf)
  75.           (while (< 0 (getvar 'cmdactive))
  76.             (vl-cmdf "")
  77.           )
  78.           (setq eell (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P")))))
  79.           (foreach e ell
  80.             (foreach ee eell
  81.               (setq pll (vlax-invoke (vlax-ename->vla-object e) 'intersectwith (vlax-ename->vla-object ee) acextendnone))
  82.               (if pll
  83.                 (repeat (/ (length pll) 3)
  84.                   (setq pl (cons (list (car pll) (cadr pll) (caddr pll)) pl))
  85.                   (setq pll (cdddr pll))
  86.                 )
  87.               )
  88.             )
  89.           )
  90.           (if (null pl)
  91.             (setq pl (cons (vlax-curve-getstartpoint (car ell)) pl))
  92.           )
  93.           (vl-cmdf "_.UNDO" "2")
  94.         )
  95.       )
  96.       (if (and (entget surf) (entget nurbs))
  97.         (entdel surf)
  98.       )
  99.     )
  100.   )
  101.   (if ucsf
  102.     (vl-cmdf "_.UCS" "_P")
  103.   )
  104.   pl
  105. )
  106.  

M.R.
« Last Edit: March 27, 2019, 05:06:56 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube