rewite lisp to use cogo points ?

[Anonymous]

COULD SOMEONE PLEASE REWRITE THIS TO USE COGO POINTS THANKYOU.

(defun c:TesT (/ cmd p&t L n L1 L2 p_t ep_t :p1 :p2 :p1z )
(vl-load-com)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.undo" "_begin")
(if
(and
(princ "\nSelect points and mtexts to align")
(setq p&t (ssget '((0 . "POINT,MTEXT"))))
(setq L (car (entsel "\nSelect the reference line")))
(= "LINE" (cdr (assoc 0 (entget L))))
(or oL (setq oL 0.00))
(setq oL
(cond
( (getdist (strcat "\nOffset from the line <" (rtos oL 2 2) ">: ")) )
( oL )
)
)
)
(progn
(setq L1 (cdr (assoc 10 (entget L))))
(setq L2 (cdr (assoc 11 (entget L))))
(setq L1 (list (car L1) (cadr L1)))
(setq L2 (list (car L2) (cadr L2)))
(repeat (setq n (sslength p&t))
(setq p_t (ssname p&t (setq n (1- n))))
(setq :p1 (cdr (assoc 10 (setq ep_t (entget p_t)))))
(setq :p1z (last :p1) :p1 (list (car :p1) (cadr :p1)))
(setq :p2 (LM:ProjectPointToLine :p1 L1 L2))
(if (not (equal oL 0.0 1e-6)) (setq :p2 (polar :p2 (angle :p2 :p1) oL)))
(if (= "POINT" (cdr (assoc 0 ep_t)))
(progn
(setq :p2 (list (car :p2) (cadr :p2) :p1z))
(vla-put-Coordinates (vlax-ename->vla-object p_t) (vlax-3d-point :p2))
)
(progn
(setq :p2 (list (car :p2) (cadr :p2) :p1z))
(setq :p2 (polar :p2 (angle :p2 :p1) (* 1.7 (cdr (assoc 40 ep_t)))))
(vla-put-InsertionPoint (vlax-ename->vla-object p_t) (vlax-3d-point :p2))
)
)
)
)
)
(setvar 'cmdecho cmd)
(command "_.undo" "_end")
(princ)
)
;; Project Point onto Line - Lee Mac
;; Projects pt onto the line defined by p1,p2
(defun LM:ProjectPointToLine ( pt p1 p2 / nm )
(setq nm (mapcar '- p2 p1)
p1 (trans p1 0 nm)
pt (trans pt 0 nm)
)
(trans (list (car p1) (cadr p1) (caddr pt)) nm 0)
)

[Jeff_M]

@Anonymous Please explain exactly what you want the lisp to do. Also, when posting code, please use the code option in the menu bar "</>" so it keeps the formatting and is easier to read.

[hippe013]

I've gone ahead and added the ability to be used on cogo points. The code itself could use some refactoring, but wasn't going to stop and re-write the entire code. The following example works. 

(@Jeff_M Jeff,

The code projects the position of a point, mtext, and now cogo point onto the selected line. )

P.S. Glad to see that credit was still being given for Lee Mac's contribution to the code and somebody didn't just erase it. 

(defun c:Test (/ cmd p&t L n L1 L2 p_t ep_t :p1 :p2 :p1z  )
  (vl-load-com)
  (setq cmd (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "_.undo" "_begin")
  (if (and (princ "\nSelect points and mtexts to align")
	   (setq p&t (ssget '((0 . "POINT,MTEXT,AECC_COGO_POINT"))))
	   (setq L (car (entsel "\nSelect the reference line")))
	   (= "LINE" (cdr (assoc 0 (entget L))))
	   (or oL (setq oL 0.00))
	   (setq oL (cond ((getdist (strcat "\nOffset from the line <" (rtos oL 2 2) ">: ")) )( oL ))))
    (progn
      (setq L1 (cdr (assoc 10 (entget L))))
      (setq L2 (cdr (assoc 11 (entget L))))
      (setq L1 (list (car L1) (cadr L1)))
      (setq L2 (list (car L2) (cadr L2)))
      (repeat (setq n (sslength p&t))
	(setq p_t (ssname p&t (setq n (1- n))))
	(setq ep_t (entget p_t))
	(if (= "AECC_COGO_POINT" (cdr (assoc 0 ep_t)))
	  (progn
	    (setq obj (vlax-ename->vla-object p_t))
	    (setq :p1 (list (vlax-get-property obj 'Easting)(vlax-get-property obj 'Northing) (vlax-get-property obj 'Elevation))))
	  (setq :p1 (cdr (assoc 10 ep_t))))
	(setq :p1z (last :p1) :p1 (list (car :p1) (cadr :p1)))
	(setq :p2 (LM:ProjectPointToLine :p1 L1 L2))
	(if (not (equal oL 0.0 1e-6)) (setq :p2 (polar :p2 (angle :p2 :p1) oL)))	
	(cond ((= "POINT" (cdr (assoc 0 ep_t)))
	       (progn
		 (setq :p2 (list (car :p2) (cadr :p2) :p1z))
		 (vla-put-Coordinates (vlax-ename->vla-object p_t) (vlax-3d-point :p2))))
	      ((= "MTEXT" (cdr (assoc 0 ep_t)))
	       (progn
		 (setq :p2 (list (car :p2) (cadr :p2) :p1z))
		 (setq :p2 (polar :p2 (angle :p2 :p1) (* 1.7 (cdr (assoc 40 ep_t)))))
		 (vla-put-InsertionPoint (vlax-ename->vla-object p_t) (vlax-3d-point :p2))))
	      ((= "AECC_COGO_POINT" (cdr (assoc 0 ep_t)))
	       (progn
		 (setq :ps (list (car :p2) (cadr :p2) :p1z))
		 (setq obj (vlax-ename->vla-object p_t))
		 (vlax-put-property obj 'Northing (cadr :ps))
		 (vlax-put-property obj 'Easting (car :ps))
		 (vlax-put-property obj 'Elevation (caddr :ps))))
	      )
	)
      )
    )
  (setvar 'cmdecho cmd)
  (command "_.undo" "_end")
  (princ)
  )
;; Project Point onto Line - Lee Mac
;; Projects pt onto the line defined by p1,p2
(defun LM:ProjectPointToLine ( pt p1 p2 / nm )
(setq nm (mapcar '- p2 p1)
p1 (trans p1 0 nm)
pt (trans pt 0 nm)
)
(trans (list (car p1) (cadr p1) (caddr pt)) nm 0)
)

[Jeff_M]

@hippe013 thanks. I knew what it was doing with Acad points and Mtext, I just wanted to be sure the OP actually wanted the exact same thing for CogoPoints. I've seen requests for similar tools, but were strictly for rotating the Labels to align with an object without moving them onto it. You've given exactly what was asked for, thanks! 

And I agree regarding keeping the Lee Mac function intact. It's always nice to see people's work appreciated and not needing to 'clean it up to claim as my own'.