Jump to content

Get points on a 3D curve with the same Z coordinate corresponding?


Recommended Posts

Posted (edited)
(defun c:te1 ( / obj p1 )
   (if
       (and
           (setq p1 (getpoint "\nPick point: "))
           (setq obj (car (entsel)))
       )
       (entmake (list '(0 . "POINT") (cons 10 (vlax-curve-getclosestpointto obj (trans p1 1 0) t))))
   )
   (princ)
)

Specify a point P1, and then find the same point on the curve as the specified point P1 (Z coordinate), because there is more than one point on the curve that is the same as P1 (Z coordinate), there may be two or more, the program is written as Find the closest point to P1,
How can I rewrite the program?

Thanks!

test.dwg

Edited by myloveflyer
Posted (edited)

Went down the rabbit hole with this one. use the sweep command to make a solid then the section command to create a region. using that region to get the center point. it gets close to your original point depending on how precise you need it to be this might be an option.

 

Yours: 26929.90319485, 79113.93293580, 0.00000000

Mine: 26929.90334225, 79113.93304495, 0.00000000

Distance = 0.00018342

 

 

 

 

Edited by mhupp
Removed code
Posted
5小时前,mhupp说:

带着这个掉进了兔子洞。使用sweep命令创建实体,然后使用section命令创建区域。使用该区域来获得中心点。它会接近你的原点,取决于你需要它有多精确,这可能是一个选项。

 

你的:26929,19485,79113,29380,0.00000000

我的:26334225,7913,0.0000000005

距离= 0.00018342

 

;;----------------------------------------------------------------------------;;
;; FIND POINTS ALONG 3D CURVE AT Z ELEVATION
(defun C:points (/ C p1 cir soild en ent x)
  (setq SS (ssadd))
  (setq C (car (entsel "\nSelect Curve: ")))
  (setq p1 (getpoint "\nPick point: "))
  (entmake (list (cons 0 "CIRCLE")
                 (cons 10 '(0 0 0))
                 (cons 40 1)
           )
  )
  (setq Cir (entlast))
  (command "._Sweep" cir "" C)
  (setq Solid (entlast))
  (command "_.Section" Solid "" "XY" p1)
  (if (setq en (entnext Solid))
    (while en
      (ssadd en SS)
      (setq en (entnext en))
    )
  )
  (if (< (sslength ss) 0)
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq x (append (vlax-get (vlax-ename->vla-object ent) 'centroid) (list (caddr p1))))
      (entmake (list (cons 0 "POINT")
                     (cons 10 x)
               )
      )
      (entdel ent)
    )
    (prompt "\nNo Points found")
  )
  (entdel Solid)
  (entdel Cir)  
  (princ)
)

 

 

Hi,Mhupp。I have read your program, why does the program always appear "No Points found", for the test graph "test.dwg", there must be an intersection between the XY plane and the 3D curve, because the 3D curve passes through the XY plane, Why there is no intersection when the program runs? After the program runs, the 3D curve needs to be preserved.

Posted (edited)
3 hours ago, myloveflyer said:

Hi,Mhupp。I have read your program, why does the program always appear "No Points found", for the test graph "test.dwg", there must be an intersection between the XY plane and the 3D curve, because the 3D curve passes through the XY plane, Why there is no intersection when the program runs? After the program runs, the 3D curve needs to be preserved.

 

Because I'm dumb an used less than instead of greater than in my if statement. its needed because you could pick a point that has a z elevation outside the curve. thus nothing will be generated and would cause an error. everything should work now. either re download the code or change he following.

 

use updated code above

Edited by mhupp
Posted
4 hours ago, mhupp said:

 

Because I'm dumb an used less than instead of greater than in my if statement. its needed because you could pick a point that has a z elevation outside the curve. thus nothing will be generated and would cause an error. everything should work now. either re download the code or change he following.

 

use updated code above

Thanks,mhupp.

After the program runs, the generated points are not on the 3D curve, but they are very close.
Is such an error related to the control accuracy?
Because such points need to be calculated a lot, the accumulation of errors will be relatively large.

Posted

like I said before depending on how precise you need these points to be this might be an option. The distance between my point an yours in the test drawing was 0.00018342

If you need exact point locations don't use this lisp.

Posted (edited)
1 hour ago, mhupp said:

like I said before depending on how precise you need these points to be this might be an option. The distance between my point an yours in the test drawing was 0.00018342

If you need exact point locations don't use this lisp.

Yes, mhupp!
The conventional practice is to switch the view to operate, but because there are many points, a LISP is needed to complete it. The point I hope to get is on the 3D curve, because not all points are the Z coordinates of the reference point. It is also possible that the X coordinate or the Y coordinate corresponds.
How many bits does this precision need to be set to get the points on the 3D curve?

Edited by myloveflyer
Posted

Scratch my lisp ill make a new one tonight. but if you want to get exact points right now make a surface at the z elevation. then use imprint command. select the surface then the 3d polyline. say no when it ask if you want to delete. once imprint is done explode the surface and it should have points where the curve crossed through the surface.

 

Example

https://ibb.co/D8cvs3p

 

Your point: 26929.90319485, 79113.93293580, 0.00000000

Found point: 26929.90319485, 79113.93293580, 0.00000000

 

Posted (edited)

This lisp gets exact points of the curve at z elevation of point picked. had to add a little fuzz distance because splines act a little weird with bounding boxe calculations. If you keep getting an error message "Curve Dosn't Reach Elevation of: XXX.xxx" . increase the fuzz distance. currently its set to 150.

 

LL (mapcar '- LL  '(150 150 150))

UR (mapcar '+ UR  '(150 150 150))

 

 

;;----------------------------------------------------------------------------;;
;; FIND POINTS ALONG 3D CURVE AT Z ELEVATION
(defun C:points (/ SS Curve C pt LL UR p1 p2 p3 p4 x en ent)
  (setq ss (ssadd))
  (setq Curve (vlax-ename->vla-object (setq C (car (entsel "\nSelect Curve: ")))))
  (vla-GetBoundingBox Curve 'LL 'UR)
  (setq pt (getpoint "\nPick point: "))
  (setq LL (vlax-safearray->list LL)
        UR (vlax-safearray->list UR)
        LL (mapcar '- LL  '(150 150 150))
        UR (mapcar '+ UR  '(150 150 150)) 
        p1 (list (car LL) (cadr LL) (caddr pt))
        p2 (list (car UR) (cadr LL) (caddr pt))
        p3 (list (car UR) (cadr UR) (caddr pt))
        p4 (list (car LL) (cadr UR) (caddr pt))
  )
  (if (< (caddr LL) (caddr pt) (caddr UR))
    (progn
      (entmake (list (cons 0 "3DFACE")
                     (cons 10 p1)
                     (cons 11 p2)
                     (cons 12 p3)
                     (cons 13 p4)
               )
      )
      (setvar 'cmdecho 0)
      (command "_.Region" (setq x (entlast)) "")
      (command "_.Imprint" (entlast) C  "" "")
      (command "_.Explode" (entlast)) 
      (command "_.Explode" "_P") 
      (if (setq en (entnext x))
        (while en
          (ssadd en SS)
          (setq en (entnext en))
        )
      )   
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (if (not (eq (cdr (assoc 0 (entget ent))) "POINT"))
          (entdel ent)
        )
      )
      (setvar 'cmdecho 1)
    )
    (prompt (strcat "\nCurve Dosn't Reach Elevation of: " (rtos (caddr pt) 2)))
  )
  (princ)
)

 

--Edit--

wont work properly if UCS isn't set to world.

 

Edited by mhupp
ucs note

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...