Topic: {=-Challenge-=} - closestpointto on reference surface from 3D point in space

[It's Alive!]

Here is my entry for Surface, should work in 2019-2020

Code: [Select]

(defun c:doit ( /)
  (setq p (getpoint "Where? "))
  (setq e (car(entsel)))
  (setq r (vlaxSurfaceGetClosestPointTo e p))
  (distance p r)
)

inspiration from Alexander Rivilis - https://adn-cis.org/forum/index.php?topic=59.msg4561#msg4561

edit added a module for BricsCAD V20

[ribarm]

Code: [Select]

: APPLOAD
Loading C:\                  TESTING ROUTINES\ArxBrxClosestPoint.brx
Error loading "C:\                  TESTING ROUTINES\ArxBrxClosestPoint.brx": .
C:\                  TESTING ROUTINES\ArxBrxClosestPoint.brx loading failed.
Loading C:\                  TESTING ROUTINES\ArxBrxClosestPoint.arx
Error loading "C:\                  TESTING ROUTINES\ArxBrxClosestPoint.arx": .
C:\                  TESTING ROUTINES\ArxBrxClosestPoint.arx loading failed.

Tried from BricsCAD V19.2.14 (x64)

BTW. I also have AutoCAD 2018 (x64), but not 2019, 2020... I suppose from your statement 2019-2020 that it won't arxload there either...

Also I would write test function like this :

Code: [Select]

(defun c:doit ( / surf pt )
  (while
    (or
      (not (setq surf (car (entsel "\nPick SURFACE..."))))
      (if surf
        (not (wcmatch (cdr (assoc 0 (entget surf))) "*SURFACE*"))
      )
    )
    (prompt "\nMissed or picked wrong entity type...")
    (textscr)
  )
  (initget 1)
  (setq pt (getpoint "\nPick or specify reference point : "))
  (entmake (list '(0 . "POINT") (cons 10 (vlaxsurfacegetclosestpointto surf (trans pt 1 0)))))
  (princ (cdr (assoc 10 (entget (entlast)))))
  (princ)
)


[It's Alive!]

Try this one with V19

[It's Alive!]

Also I would write test function like this :

mine only works with surfaces

[ribarm]

Also I would write test function like this :

mine only works with surfaces

I've corrected test function...
Thanks it's working now with my BricsCAD...

[It's Alive!]

this one might work with surfaces, 3Dsolids and regions...
I changed the name from vlaxsurfacegetclosestpointto to getClosestPointTo

[ribarm]

this one might work with surfaces, 3Dsolids and regions...
I changed the name from vlaxsurfacegetclosestpointto to getClosestPointTo

Code: [Select]

(defun c:doit ( / f surf pt )
  (if (not (vl-position "arxbrxclosestpointv19.brx" (arx)))
    (progn
      (setq f (getfiled "Select ArxBrxClosestPointv19.brx file..." "\\" "brx" 16))
      (arxload f)
    )
  )
  (while
    (or
      (not (setq surf (car (entsel "\nPick SURFACE, or 3DSOLID, or REGION..."))))
      (if surf
        (not (wcmatch (cdr (assoc 0 (entget surf))) "*SURFACE*,3DSOLID,REGION"))
      )
    )
    (prompt "\nMissed or picked wrong entity type...")
    (textscr)
  )
  (initget 1)
  (setq pt (getpoint "\nPick or specify reference point : "))
  (entmake (list '(0 . "POINT") (cons 10 (getclosestpointto surf (trans pt 1 0)))))
  (princ (cdr (assoc 10 (entget (entlast)))))
  (princ)
)

Daniel, I need to know :
It's not possible or it's hard to do *.arx version for AutoCAD - say : 2014-2018 either for just surfaces or like you last did - surfaces, 3dsolids, regions?

If not possible, I may consider porting from Brics to Auto through scripting...

[It's Alive!]

Yeah sure, should be easy. Does it work as advertised?, I only briefly tested on very simple objects.
I’ll post binaries and source in show my stuff in the next couple days

[It's Alive!]

I don't have 2018, but try this one

[ribarm]

Yeah sure, should be easy. Does it work as advertised?, I only briefly tested on very simple objects.
I’ll post binaries and source in show my stuff in the next couple days

And me too - tested on very simple objects and it works...

BTW. I already ported :

Code: [Select]

(defun c:zper ( / str+ surf es pt folder path f shell apphandle apphandle-b )

  (vl-load-com)

  (defun str+ ( source / prefix rchar )
    (cond
      ( (= source "") "A")
      ( (= (setq prefix (substr source 1 (1- (strlen source)))
                  rchar (substr source (strlen source))
            )
            "Z"
        )
        (strcat (str+ prefix) "A")
      )
      ( (strcat prefix (chr (1+ (ascii rchar)))))
    )
  )

  (while
    (or
      (not (setq surf (car (setq es (entsel "\nPick SURFACE, or 3DSOLID, or REGION...")))))
      (if surf
        (not (wcmatch (cdr (assoc 0 (entget surf))) "*SURFACE*,3DSOLID,REGION"))
      )
    )
    (prompt "\nMissed or picked wrong entity type...")
    (textscr)
  )
  (initget 1)
  (setq pt (getpoint "\nPick or specify reference point : "))
  (while (findfile (setq path (strcat "c:\\" (if (null folder) (setq folder (str+ "")) (setq folder (str+ folder)))))))
  (acet-file-mkdir path)
  (vl-cmdf "_.-WBLOCK" (strcat path "\\surf.dwg") "" "_non" '(0.0 0.0 0.0) surf "")
  (vl-cmdf "_.UNDO" "1")
  (setq f (open (strcat path "\\surf.scr") "w"))
  (write-line "(if (not (vl-position \"arxbrxclosestpointv19.brx\" (arx)))" f)
  (write-line "(progn" f)
  (write-line "(setq f (getfiled \"Select ArxBrxClosestPointv19.brx file...\" \"\\\\\" \"brx\" 16))" f)
  (write-line "(arxload f)" f)
  (write-line ")" f)
  (write-line ")" f)
  (write-line (strcat "(setq surf (car (nentselp (list " (rtos (car (cadr es)) 2 20) " " (rtos (cadr (cadr es)) 2 20) " " (rtos (caddr (cadr es)) 2 20) "))))") f)
  (write-line (strcat "(setq pt (list " (rtos (car pt) 2 20) " " (rtos (cadr pt) 2 20) " " (rtos (caddr pt) 2 20) "))") f)
  (write-line "(entmake (list '(0 . \"POINT\") (cons 10 (getclosestpointto surf (trans pt 1 0)))))" f)
  (write-line "_.-WBLOCK" f)
  (write-line (strcat "\"" path "\\surf-BCAD.dwg" "\"") f)
  (write-line "" f)
  (write-line "0,0,0" f)
  (write-line "_LAST" f)
  (write-line "" f)
  (write-line "_.QUIT" f)
  (write-line "_Y" f)
  (close f)
  (startapp "cmd.exe /C taskkill /IM \"rlm.exe\" /F")
  (vl-cmdf "_.DELAY" 2000)
  (setq shell (vlax-get-or-create-object "Wscript.Shell"))
  (setq apphandle (vlax-invoke-method shell 'Exec "c:\\Program Files (x86)\\Bricsys\\Bricsys Network License Manager\\rlm.exe"))
  (if (= (vlax-get-property apphandle 'Status) 0)
    (setq apphandle-b (vlax-invoke-method shell 'Exec (strcat "C:\\Program Files\\Bricsys\\BricsCAD V19 en_US\\bricscad.exe " path "\\surf.dwg" " /B " path "\\surf.scr")))
  )
  (while (= (vlax-get-property apphandle-b 'Status) 0))
  (vl-cmdf "_.INSERT" (strcat path "\\surf-BCAD.dwg") "_non" '(0.0 0.0 0.0))
  (while (< 0 (getvar 'cmdactive))
    (vl-cmdf "")
  )
  (vl-cmdf "_.EXPLODE" "_L")
  (while (< 0 (getvar 'cmdactive))
    (vl-cmdf "")
  )
  (vl-file-delete (strcat path "\\surf.dwg"))
  (vl-file-delete (strcat path "\\surf.scr"))
  (vl-file-delete (strcat path "\\surf-BCAD.dwg"))
  (acet-file-rmdir path)
  (vlax-invoke-method apphandle 'Terminate)
  (vlax-release-object apphandle)
  (vlax-release-object apphandle-b)
  (vlax-release-object shell)
  (vl-cmdf "_.-PURGE" "_B" "surf-BCAD" "_N")
  (princ (cdr (assoc 10 (entget (entlast)))))
  (princ)
)

So now you have to have BricsCAD V19 and any AutoCAD...
I'll check your *.arx nevertheless and see if it works for A2018...

Thanks again, M.R.

[ribarm]

I've tested it on simple objects and it works and for A2018...

Thanks again, M.R.

[It's Alive!]

Here's the source and builds 2013-2020, v18-v20
I can't verify that older versions for acad load, so if you see one that doesn't, let me know

[ribarm]

I am using this occaison to wish you Happy Birthday, Daniel...

All the best and take care, M.R.

[It's Alive!]

I am using this occaison to wish you Happy Birthday, Daniel...

All the best and take care, M.R.

Thank you 

[ahsattarian]

I Draw a point on that point and then  :



 

Code - Auto/Visual Lisp: [Select]

1.       (command "point" po)
2.        (setq point (entlast))
3.        (command "projectgeometry" point "" sl "ucs")
4.        (setq z (caddr (cdr (assoc 10 (entget (entlast))))))
5.        (entdel (entlast))
6.        (entdel point)