Lisp Routine Help - Moving COGO points to the nearest selected polylines

[hbrown63GVA]

Hello, 

I am pretty new here so please take it easy on me. HAHA. 

I am in need of some help. We use a lisp routine at work in Civil3D 2023 that allows us to move Cogo points to a selected polyline to save us some time. This lisp allows us to select one polyline and then we select the group of Cogo points we would like to move to that polyline. It works, but I am trying to find a way to make the LISP more efficient. I have provided the base code that I have come up with so far below:

(defun c:MoveCOGOPointsToNearestPolyline (/ ss i ent pt1 pt2 elist p ss2)
(princ "\nSelect polylines: ")
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(progn
(setq elist (ssnamex ss))
(princ "\nSelect COGO points: ")
(if (setq ss2 (ssget '((0 . "AECC_COGO_POINT"))))
(progn
(repeat (setq i (sslength ss2))
(setq ent (ssname ss2 (setq i (1- i))))
(if (= "AECC_COGO_POINT" (cdr (assoc 0 (entget ent))))
(progn
(setq pt1 (cdr (assoc 10 (entget ent))))
(foreach x elist
(setq p (vlax-curve-getClosestPointTo
x
pt1
)
)
(if (< (distance p pt1) (distance pt2 pt1))
(setq pt2 p)
)
)
(command "_.move" ent "" pt1 pt2)
)
(princ "\nInvalid selection. Please select a COGO point.")
)
)
)
)
)
)
(princ)
)

When I run this LISP. I get the following result:

Activate command

Select Polyline

Enter

Select Cogo Points 

Enter

I then get Error: unable to get ObjectID (entity name: this info changes depending on the cogo points selected)

The end result I am looking for is:

I would like to be able to select all the polylines in a drawing and then select all the cogo points in a drawing and move those points to the closest selected polyline at the same time. i would also like it to prompt where to move the point whether is nearest, end points, or midpoints.

- Thank You

[hosneyalaa]

Hi

Change

(setq pt1 (cdr (assoc 10 (entget ent))))

To

(setq cogopoint

(vlax-ename->vla-object  ent))

(setq pt1 (vlax-get cogopoint 'location))

[Jeff_M · Accepted solution]

Using the Location property for a CogoPoint which hasn't been assigned an elevation will break the test for closest point.

@hbrown63GVA please use the Insert/Edit code icon when posting code, it helps to keep the formatting. 

I've made a few changes to the code. It now seems to be working correctly. I'm not sure what you meant by this: "i would also like it to prompt where to move the point whether is nearest, end points, or midpoints."

(defun c:MoveCOGOPointsToNearestPolyline
       (/ ss i ent pt1 pt2 x p ss2 j)
  (princ "\nSelect polylines: ")
  (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (princ "\nSelect COGO points: ")
      (if (setq ss2 (ssget '((0 . "AECC_COGO_POINT"))))
	(progn
	  (repeat (setq i (sslength ss2))
	    (setq ent (ssname ss2 (setq i (1- i)))
		  cogopt (vlax-ename->vla-object ent)
		  )
;;;	    (if	(= "AECC_COGO_POINT" (cdr (assoc 0 (entget ent))))
;;;	      (progn No need to check if it's a CogoPoint, the ssfilter is all that is needed
		(setq pt1 (list (vlax-get cogopt 'easting)
				(vlax-get cogopt 'northing)
				0.0)
	              pt2 (polar pt1 0 10000)
		      j -1
		      )
		(while (setq x (ssname ss (setq j (1+ j))))
		  (setq	p (vlax-curve-getClosestPointTo
			    x
			    pt1
			  )
		  )
		  (if (< (distance p pt1) (distance pt2 pt1))
		    (setq pt2 p)
		  )
		)
		(command "_.move" ent "" pt1 pt2)
;;;	      )
;;;	      (princ "\nInvalid selection. Please select a COGO point.")
;;;	    )
	  )
	)
      )
    )
  )
  (princ)
)

[hbrown63GVA]

N/A

[hbrown63GVA]

Hello Jeff,

 Thank you for the quick response. The code modifications you made work great! 

The endpoint request was using this same process but instead of sending the points to the nearest line it would send the selected points to the nearest endpoint.

[Jeff_M]

I still don't understand what you want to do...what determines whether a point goes to the closest point on a pline or an endpoint? Perhaps a small drawing showing exactly what you need will help.

[hbrown63GVA]

I have provided a video. We use the 2 command to start the routine. This routine allows us to select a polyline and then cogo points. After the cogo points have been selected, it moves the cogo points to the end points. 

We would like to select multiple polylines, select multiple cogo points, then move the selected cogo points to closest endpoints of the selected polylines. 

[Jeff_M]

So you are wanting 2 separate lips routines, one to move points to the closest polyline, another to move points to the closest endpoint of polylines? 

Based on the video, is that the reason for the lisp...to keep points linked to the endpoints of a polyline when it is edited? If so, you may be interested in the Dynamic Linking tools in the Sincpac.

[Jeff_M]

Here are 2 new lisp routines. The first will move selected cogopoints to the closest endpoint of the closest selected polylines. The other will move selected cogopoints to the closest end point of the closest segment, of the closest  selected polylines.

(defun c:MoveCOGOPointsToNearestPolylineEndpoint
       (/ ss i ent pt1 pt2 x p ss2 j cogopt)
  (princ "\nSelect polylines: ")
  (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (princ "\nSelect COGO points: ")
      (if (setq ss2 (ssget '((0 . "AECC_COGO_POINT"))))
	(progn
	  (repeat (setq i (sslength ss2))
	    (setq ent (ssname ss2 (setq i (1- i)))
		  cogopt (vlax-ename->vla-object ent)
		  )
		(setq pt1 (list (vlax-get cogopt 'easting)
				(vlax-get cogopt 'northing)
				0.0)
	              pt2 (polar pt1 0 10000)
		      j -1
		      )
		(while (setq x (ssname ss (setq j (1+ j))))
		  (setq	p (vlax-curve-getStartPoint x))
		  (if (< (distance p pt1) (distance pt2 pt1))
		    (setq pt2 p)
		  )
		  (setq	p (vlax-curve-getEndPoint x))
		  (if (< (distance p pt1) (distance pt2 pt1))
		    (setq pt2 p)
		  )
		)
		;;(command "_.move" ent "" pt1 pt2)
	    (vlax-put cogopt 'easting (car pt2))
	    (vlax-put cogopt 'northing (cadr pt2))
	  )
	)
      )
    )
  )
  (princ)
)

(defun c:MoveCOGOPointsToNearestPolylineSegmentEndpoint
       (/ ss i ent pt1 pt2 x p ss2 j cogopt)
  (princ "\nSelect polylines: ")
  (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (princ "\nSelect COGO points: ")
      (if (setq ss2 (ssget '((0 . "AECC_COGO_POINT"))))
	(progn
	  (repeat (setq i (sslength ss2))
	    (setq ent (ssname ss2 (setq i (1- i)))
		  cogopt (vlax-ename->vla-object ent)
		  )
		(setq pt1 (list (vlax-get cogopt 'easting)
				(vlax-get cogopt 'northing)
				0.0)
	              pt2 (polar pt1 0 10000)
		      j -1
		      )
		(while (setq x (ssname ss (setq j (1+ j))))
		  (setq param (vlax-curve-getstartparam x))
		  (while (<= param (vlax-curve-getendparam x))
		  	(setq	p (vlax-curve-getpointatparam x param))
		  	(if (< (distance p pt1) (distance pt2 pt1))
		    		(setq pt2 p)
		  	)
		    (setq param (1+ param))
		  )
		)
		;;(command "_.move" ent "" pt1 pt2)
	    (vlax-put cogopt 'easting (car pt2))
	    (vlax-put cogopt 'northing (cadr pt2))
	  )
	)
      )
    )
  )
  (princ)
)

[hbrown63GVA]

Hello Jeff,  

Thanks for the reply. Correct! That's exactly what we need except we need to snap the points to the closest vertex of the closest polyline to the point. In our office, we use a Leica point cloud. We are taking our topo shots for the EOP, Flowline, BOC, and Concrete on the cloud, we then use Lisp routines to move the selected points to the line and endpoints. It's more for clean-up and aesthetics. 

[hbrown63GVA]

Sorry, I saw the code you posted once I submitted my response. 

[hbrown63GVA]

Jeff, you are a wizard my friend. Thank you very much. Both of the lisp worked as expected! 

- Thanks

[hbrown63GVA]

I have one more question and I’ll close this out. 

The original base code I provided when I first opened this thread was my code. You assisted us in fixing the error we were getting.  When we run the routine we noticed it requires Osnap to be off, where the most recent ones did not. We also noticed it seems a bit slower. Do you see any way to optimize the code to make it run faster instead if seeming to take a few seconds? 

[Jeff_M]

The Osnap issue is due to using the Move command which I eliminated in the last 2 lisps by just changing the Northing and Easting of the cogopoints. This may also be why they are a bit quicker. This also allows a single Undo to affect all the moved points, whereas using the Move command would require an undo for each point moved.

[hbrown63GVA]

Is there any way to modify this code to move the points to the nearest polyline?  We are trying to get around the OSNAP issue. 

(defun c:MoveCOGOPointsToNearestPolylineSegmentEndpoint
       (/ ss i ent pt1 pt2 x p ss2 j cogopt)
  (princ "\nSelect polylines: ")
  (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (princ "\nSelect COGO points: ")
      (if (setq ss2 (ssget '((0 . "AECC_COGO_POINT"))))
	(progn
	  (repeat (setq i (sslength ss2))
	    (setq ent (ssname ss2 (setq i (1- i)))
		  cogopt (vlax-ename->vla-object ent)
		  )
		(setq pt1 (list (vlax-get cogopt 'easting)
				(vlax-get cogopt 'northing)
				0.0)
	              pt2 (polar pt1 0 10000)
		      j -1
		      )
		(while (setq x (ssname ss (setq j (1+ j))))
		  (setq param (vlax-curve-getstartparam x))
		  (while (<= param (vlax-curve-getendparam x))
		  	(setq	p (vlax-curve-getpointatparam x param))
		  	(if (< (distance p pt1) (distance pt2 pt1))
		    		(setq pt2 p)
		  	)
		    (setq param (1+ param))
		  )
		)
		;;(command "_.move" ent "" pt1 pt2)
	    (vlax-put cogopt 'easting (car pt2))
	    (vlax-put cogopt 'northing (cadr pt2))
	  )
	)
      )
    )
  )
  (princ)
)

[hbrown63GVA]

Thank you so much for that tip! 

[Jeff_M]

To disable any osnaps while the lisp is running, add this line:

(setvar 'osmode (+ (getvar 'osmode) 16384))

just above the line prompting to select polylines. Then, to reenable once the points are processed, add this line:

(setvar 'osmode (- (getvar 'osmode) 16384))

just above the (princ) line.

[CoraForun]

I asked a question, but ignore me, I made a new post.