Author Topic: Move point perpendicular to line  (Read 2928 times)

0 Members and 1 Guest are viewing this topic.

lkrkck

  • Mosquito
  • Posts: 2
Move point perpendicular to line
« on: September 12, 2017, 07:29:03 AM »
Hello,

I've this code to move some AcadPoints tPerpendicular of one 2DPoliline.
The problem: I've this points with Z value, when i run the code this points goes perpendicular to line but with Z=0.

Code: [Select]
(defun c:SnapToObj ( / en obj pts_ss ss_len c pten ptobj pted pt pt2)
(setq en (car (entsel "\nSelect Object: ")))
(setq obj (vlax-ename->vla-object en))
(princ "\nSelect points: ")
(setq pts_ss (ssget (list (cons 0 "POINT"))))
(setq ss_len (sslength pts_ss))
(setq c 0)
(while (< c ss_len)
(setq pten (ssname pts_ss c))
(setq ptobj (vlax-ename->vla-object pten))
(setq pted (entget pten))
(setq pt (cdr (assoc 10 pted)))
(setq pt2 (vlax-curve-getClosestPointTo obj pt))
(vla-move ptobj (vlax-3d-point pt) (vlax-3d-point pt2))
(setq c (+ c 1))
)
(princ)
)

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18

ronjonp

  • Needs a day job
  • Posts: 7527
Re: Move point perpendicular to line
« Reply #3 on: September 12, 2017, 09:20:59 AM »
The point Z value should equal whatever elevation the polyline it is snapping to ?  Here's a quick one to retain the original Z value:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:s2o (/ e el p p2 s)
  2.   ;; RJP - 9/12/2017
  3.   (if (and (setq e (car (entsel "\nSelect Object: ")))
  4.            (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
  5.            (princ "\nSelect points: ")
  6.            (setq s (ssget ":L" (list '(0 . "POINT"))))
  7.       )
  8.     (foreach pt (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
  9.       (setq p (cdr (assoc 10 (setq el (entget pt)))))
  10.       (entmod (append el (list (cons 10 (list (car p2) (cadr p2) (caddr p))))))
  11.     )
  12.   )
  13.   (princ)
  14. )
« Last Edit: September 12, 2017, 09:26:32 AM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

lkrkck

  • Mosquito
  • Posts: 2
Re: Move point perpendicular to line
« Reply #4 on: September 12, 2017, 09:25:34 AM »
Good Job ronjonp!
Thank you...

The point Z value should equal whatever elevation the polyline it is snapping to ?  Here's a quick one to retain the original Z value:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:s2o (/ e el p p2 s)
  2.   ;; RJP - 9/12/2017
  3.   (if (and (setq e (car (entsel "\nSelect Object: ")))
  4.            (princ "\nSelect points: ")
  5.            (setq s (ssget ":L" (list '(0 . "POINT"))))
  6.       )
  7.     (foreach pt (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
  8.       (setq p (cdr (assoc 10 (setq el (entget pt)))))
  9.       (entmod (subst (cons 10 (list (car p2) (cadr p2) (caddr p))) (assoc 10 el) el))
  10.     )
  11.   )
  12.   (princ)
  13. )

ronjonp

  • Needs a day job
  • Posts: 7527
Re: Move point perpendicular to line
« Reply #5 on: September 12, 2017, 09:29:45 AM »
Glad to help :) .. btw I updated the code above to make sure the object picked to snap to is actually a curve object.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

symoin

  • Mosquito
  • Posts: 5
Re: Move point perpendicular to line
« Reply #6 on: February 11, 2024, 10:53:22 AM »
The point Z value should equal whatever elevation the polyline it is snapping to ?  Here's a quick one to retain the original Z value:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:s2o (/ e el p p2 s)
  2.   ;; RJP - 9/12/2017
  3.   (if (and (setq e (car (entsel "\nSelect Object: ")))
  4.            (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
  5.            (princ "\nSelect points: ")
  6.            (setq s (ssget ":L" (list '(0 . "POINT"))))
  7.       )
  8.     (foreach pt (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
  9.       (setq p (cdr (assoc 10 (setq el (entget pt)))))
  10.       (entmod (append el (list (cons 10 (list (car p2) (cadr p2) (caddr p))))))
  11.     )
  12.   )
  13.   (princ)
  14. )

Hi RONJOP,
Instead of Moving a single point to a single line, Is it possible to copy the Multiple points to Multiple polylines ( to left and right side) as keeping the Z elevation the same?
Could you, please update the code.
Thanks in advance.
« Last Edit: February 11, 2024, 11:15:08 AM by symoin »

ronjonp

  • Needs a day job
  • Posts: 7527
Re: Move point perpendicular to line
« Reply #7 on: February 12, 2024, 12:51:02 PM »
Do you have a sample drawing to share with the desired results? I'm not exactly sure what you need. "copy the Multiple points to Multiple polylines ( to left and right side)"

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

symoin

  • Mosquito
  • Posts: 5
Re: Move point perpendicular to line
« Reply #8 on: February 14, 2024, 09:41:07 AM »
Hi RONJOP,
I have attached the sample, Here there is a point in the section before, which is then copies (approximately) to the nearest polylines. For my present requirement this approximate location is enough. But in code approximate location don't make any senes.

Thanks for your response.

ribarm

  • Gator
  • Posts: 3248
  • Marko Ribar, architect
Re: Move point perpendicular to line
« Reply #9 on: February 14, 2024, 10:45:22 AM »
Nothing special...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:copypts2curves ( / ss s p ptx lay p2 )
  2.   ;; RJP - 9/12/2017
  3.   ;; mod. M.R. - 02/14/2024
  4.   (if (and (princ "\nSelect curve entities : ")
  5.           (setq ss (ssget (list '(0 . "~POINT"))))
  6.           (vl-every '(lambda ( x ) (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  7.           (princ "\nSelect points : ")
  8.           (setq s (ssget (list '(0 . "POINT"))))
  9.       )
  10.     (foreach pt (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
  11.       (foreach curve (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  12.         (setq p (cdr (assoc 10 (setq ptx (entget pt)))))
  13.         (setq lay (cdr (assoc 8 ptx)))
  14.         (setq p2 (vlax-curve-getclosestpointto curve p))
  15.         (entmake (list (cons 0 "POINT") (cons 10 p2) (cons 8 lay)))
  16.       )
  17.     )
  18.   )
  19.   (princ)
  20. )
  21.  
« Last Edit: February 14, 2024, 04:15:31 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ronjonp

  • Needs a day job
  • Posts: 7527
Re: Move point perpendicular to line
« Reply #10 on: February 14, 2024, 05:02:11 PM »
Hahaha .. had it mostly written 7 years ago :) .. thanks Marko.

*Edit .. I'd format like this these days so only only one selection set is needed:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ crvs p p2 pts ptx ss)
  2.   ;; RJP - 9/12/2017
  3.   ;; mod. M.R. - 02/14/2024
  4.   (cond ((setq ss (ssget (list '(0 . "POINT,LWPOLYLINE"))))
  5.          (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  6.            (if (= "POINT" (cdr (assoc 0 (entget e))))
  7.              (setq pts (cons e pts))
  8.              (setq crvs (cons e crvs))
  9.            )
  10.          )
  11.          (foreach pt pts
  12.            (foreach curve crvs
  13.              (setq p (cdr (assoc 10 (setq ptx (entget pt)))))
  14.              (setq p2 (vlax-curve-getclosestpointto curve p))
  15.              (entmake (list '(0 . "POINT") (cons 10 p2) (assoc 8 ptx)))
  16.            )
  17.          )
  18.         )
  19.   )
  20.   (princ)
  21. )
« Last Edit: February 14, 2024, 05:11:13 PM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

symoin

  • Mosquito
  • Posts: 5
Re: Move point perpendicular to line
« Reply #11 on: February 20, 2024, 07:50:57 AM »
Thanks,
yes it is copying, can we keep the same elevations as the original point.