Topic: Move point to rectangle EndPoint

[whosa]

Hi Guys,

I need an help if this is possible.

I need to move 4 points on the corner of the closed Pline keeping the z axis of the point.

In this site, I found a so useful lisp that moves parallel to a line but it did not work for my case.

Many thanks

Code: [Select]

(defun c:s2o (/ e el p p2 s)
  ;; RJP - 9/12/2017
  (if (and (setq e (car (entsel "\nSelect Object: ")))
           (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
           (princ "\nSelect points: ")
           (setq s (ssget ":L" (list '(0 . "POINT"))))
      )
    (foreach pt (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq p (cdr (assoc 10 (setq el (entget pt)))))
      (setq p2 (vlax-curve-getclosestpointto e p))
      (entmod (append el (list (cons 10 (list (car p2) (cadr p2) (caddr p))))))
    )
  )
  (princ)
)

[DEVITG]

@WHOSA, please clear me , you want the points to be just at the vertical point polyline vertex , but POINT shall keep it's Z value .
the dwg is just to show if it is as you need it to be , only one point .
It is a small difference at z value , to be fixed by lisp .
I did it by hand.

[DEVITG]

@whosa , find attached

Code: [Select]

(DEFUN C:C2=Z  (/
                E
                EL
                P
                P2
                S
                FAR-P2
                NEAR-P2
                NEAR-PT
                NEAR-VERT-PARAM
                NEW-POINTXY@=Z
                PARAM@P2
                POINT-LIST
                )
  ;; RJP - 9/12/2017

  ;; devitg 01-05-2020
  (IF (AND
        (PRINC "\nSelect polyline : ")
        (SETQ E (SSNAME (SSGET ":S" '((0 . "*poly*"))) 0))
        (NOT (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY 'VLAX-CURVE-GETENDPARAM (LIST E))))
        (PRINC "\nSelect points: ")
        (SETQ S (SSGET ":L" (LIST '(0 . "POINT"))))
        )
    (PROGN ;;from here by   devitg
      (SETQ POINT-LIST (VL-REMOVE-IF 'LISTP (MAPCAR 'CADR (SSNAMEX S))))
      (FOREACH PT  POINT-LIST
        (SETQ P (CDR (ASSOC 10 (SETQ EL (ENTGET PT)))))
        (SETQ P2 (VLAX-CURVE-GETCLOSESTPOINTTO E P))
        (SETQ PARAM@P2 (VLAX-CURVE-GETPARAMATPOINT E P2))
        (SETQ NEAR-P2 (FIX PARAM@P2))
        (SETQ FAR-P2 (1+ NEAR-P2))
        (IF (< (ABS (- NEAR-P2 PARAM@P2)) (ABS (- FAR-P2 PARAM@P2)))
          (SETQ NEAR-VERT-PARAM NEAR-P2)
          (SETQ NEAR-VERT-PARAM FAR-P2)
          )
        (SETQ NEAR-PT (VLAX-CURVE-GETPOINTATPARAM E NEAR-VERT-PARAM))
        (SETQ NEW-POINTXY@=Z (LIST (CAR NEAR-PT) (CADR NEAR-PT) (LAST P)))
        (ENTMOD (APPEND EL (LIST (CONS 10 NEW-POINTXY@=Z))))
        ) ;end FOREACH
      ) ; progn if poly and point
    (ALERT " no poly and point selected")
    ) ;end if 
  (PRINC)
  (PRINC)
  (PRINT "\nType   C2=Z at command line");; up to here by devitg
  );end defun C:C2=Z

;|«Visual LISP© Format Options»
(180 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;


[BIGAL]

Multi posted various forums 3 questions in total.

[whosa]

@whosa , find attached

Code: [Select]

(DEFUN C:C2=Z  (/
                E
                EL
                P
                P2
                S
                FAR-P2
                NEAR-P2
                NEAR-PT
                NEAR-VERT-PARAM
                NEW-POINTXY@=Z
                PARAM@P2
                POINT-LIST
                )
  ;; RJP - 9/12/2017

  ;; devitg 01-05-2020
  (IF (AND
        (PRINC "\nSelect polyline : ")
        (SETQ E (SSNAME (SSGET ":S" '((0 . "*poly*"))) 0))
        (NOT (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY 'VLAX-CURVE-GETENDPARAM (LIST E))))
        (PRINC "\nSelect points: ")
        (SETQ S (SSGET ":L" (LIST '(0 . "POINT"))))
        )
    (PROGN ;;from here by   devitg
      (SETQ POINT-LIST (VL-REMOVE-IF 'LISTP (MAPCAR 'CADR (SSNAMEX S))))
      (FOREACH PT  POINT-LIST
        (SETQ P (CDR (ASSOC 10 (SETQ EL (ENTGET PT)))))
        (SETQ P2 (VLAX-CURVE-GETCLOSESTPOINTTO E P))
        (SETQ PARAM@P2 (VLAX-CURVE-GETPARAMATPOINT E P2))
        (SETQ NEAR-P2 (FIX PARAM@P2))
        (SETQ FAR-P2 (1+ NEAR-P2))
        (IF (< (ABS (- NEAR-P2 PARAM@P2)) (ABS (- FAR-P2 PARAM@P2)))
          (SETQ NEAR-VERT-PARAM NEAR-P2)
          (SETQ NEAR-VERT-PARAM FAR-P2)
          )
        (SETQ NEAR-PT (VLAX-CURVE-GETPOINTATPARAM E NEAR-VERT-PARAM))
        (SETQ NEW-POINTXY@=Z (LIST (CAR NEAR-PT) (CADR NEAR-PT) (LAST P)))
        (ENTMOD (APPEND EL (LIST (CONS 10 NEW-POINTXY@=Z))))
        ) ;end FOREACH
      ) ; progn if poly and point
    (ALERT " no poly and point selected")
    ) ;end if 
  (PRINC)
  (PRINC)
  (PRINT "\nType   C2=Z at command line");; up to here by devitg
  );end defun C:C2=Z

;|«Visual LISP© Format Options»
(180 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;


Many Thanks, work well.

I posted the same question in 3 forum because I needed this lisp ASAP. On the first one, I did not get an answer.

Thanks again for your time

[HasanCAD]

https://www.cadtutor.net/forum/topic/70389-move-point-to-vertex-and-draw-3d-poly/?tab=comments#comment-565246