move point to vertex and draw 3d poly

[whosa]

Hi,

 

I i'm get crazy with this task. 

 

I need to:

 

1. Moving all the 4 points to the rectangle vertex keeping the zValue of the 4 points
2. make a 3D closed poly through this vertez

 

Someone can help me with a lisp?

 

Many thank

 

test.dwg

Edited April 27, 2020 by whosa

[lrm]

As I understand your question you would like to do something like the following.  Given several mtext objects that are at different z values, you would like to move them to vertices of a rectangle but maintain the z value of each text item.

 

Noting that a 2D polyline must lie on a plane and the plane is defined by the first vertex of the pline you can use the following approach.

 

Given the following we would like to move the text to the corners of the rectangle.

Set running osnap to Insertion  and Endpoint  and create the yellow polyline (pline) being careful to snap to the insertion points of the text and the endpoints of the rectangle.  Note that I have added extra vertices.

Turn off osnap insertion but leave Endpoint active and use move while snapping to the vertices (Endpoints) of the yellow line to ensure the z values do not change. 

m 

Delete the yellow pline.

 

 

 

 

[whosa]

Thanks for you reply. I know how to do that one to one. In this project I have 790 ICs like this.

 

I need to move 3160 point by hand. 

 

Maybe this could be done by lisp. This will be amazing. Yesterday @dlanorh did a miracle with an lisp

Edited April 27, 2020 by whosa

[whosa]

Nothing to do?

 

Maybe only draw automatically 3Dpoly from 4 selected 3d point could help.

 

I will move all this point with osnapZ=1 by hand.

Edited April 27, 2020 by whosa

[whosa]

sorry, i just realized that i attached a wrong test file. 

 

Attached the correct one.

test.dwg

[BIGAL]

For anyone this is a part two of the whosa post to do road kerbs. A similar request now solved.

 

To whosa how many more questions are you really going to ask for ? This is standard day to day field survey stuff. The best solution is go back to the original data it will be some form of XYZ file hopefully it also has codes as well. Post that then we can really see how we can help.

 

For Lrm like the other post the "point",s are the correct part to join not the mtext, so pick inside and do some form of ray trace angle to sort the join order, its easy for a rectang or always convex shape draw a "H" of points to test.

 

This is from field survey auto strung, blocks added. This is what whosa wants. There are many answers out there start with Civ3D.

 

Edited April 27, 2020 by BIGAL

[BIGAL]

Anyway

(defun c:quickanddirty ( / lst ss pt1 pt2)
(while (setq ss (ssget '((0 . "POINT"))))
(setq lst '())
(setq pt1 (getpoint "\npick point inside"))
(repeat (setq x (sslength ss))
(setq pt2 (cdr (assoc 10 (entget (ssname ss (setq x (- x 1)))))))
(setq lst (cons (list (angle pt1 pt2) pt2) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
(command "_line")
(while (= (getvar "cmdactive") 1 )
(repeat (setq x (length lst))
(command (cadr (nth (setq x (- x 1)) lst)))
)
(command "C")
)
)
)

 

 

[whosa]

Thanks, 

7 hours ago, BIGAL said:

Anyway

(defun c:quickanddirty ( / lst ss pt1 pt2)
(while (setq ss (ssget '((0 . "POINT"))))
(setq lst '())
(setq pt1 (getpoint "\npick point inside"))
(repeat (setq x (sslength ss))
(setq pt2 (cdr (assoc 10 (entget (ssname ss (setq x (- x 1)))))))
(setq lst (cons (list (angle pt1 pt2) pt2) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
(command "_line")
(while (= (getvar "cmdactive") 1 )
(repeat (setq x (length lst))
(command (cadr (nth (setq x (- x 1)) lst)))
)
(command "C")
)
)
)

 

 

 

Many Thanks, much appreciated. 

 

I'm so sorry for all this question. I received this topo from a client and it is full of strange stuff. I need to convert it in 3D and I start to be crazy. 

 

To move the point under the vertex i found it but this LISP move the point Parallel to a line;

 

I need to move the 4 points on the vertex of the blue rectangle keeping the Z value. 

 

This will be my last question  @BIGAL

 

(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)
)

 

Edited April 28, 2020 by whosa

[ronjonp]

Try this:

(defun c:s2o (/ a b c d el m s)
  ;; RJP » 2020-04-29
  ;; Could give bad results for multiple vertices that are within the 'search distance'
  (cond
    ((and (setq d (getdist "\nPick a distance to search: "))
	  (setq s (ssget ":L" (list '(0 . "POINT,LWPOLYLINE"))))
     )
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (if (= "POINT" (cdr (assoc 0 (setq el (entget e)))))
	 (setq a (cons (list (cdr (assoc 10 el)) e) a))
	 (setq b (cons (vl-remove-if '(lambda (x) (/= 10 (car x))) el) b))
       )
     )
     (if (setq b (mapcar 'cdr (apply 'append b)))
       (foreach	p a
	 (setq c (mapcar '+ (car p) '(0 0)))
	 (cond
	   ((setq m (vl-some '(lambda (x) (if (equal c x d) x)) b))
	    (setq b (vl-remove m b))
	    (entmod (append (entget (cadr p)) (list (cons 10 (append m (list (last (car p))))))))
	   )
	 )
       )
     )
    )
  )
  (princ)
)

 

Edited April 29, 2020 by ronjonp

[whosa]

13 hours ago, ronjonp said:

Try this:

(defun c:s2o (/ a b c d el m s)
  ;; RJP » 2020-04-29
  ;; Could give bad results for multiple vertices that are within the 'search distance'
  (cond
    ((and (setq d (getdist "\nPick a distance to search: "))
	  (setq s (ssget ":L" (list '(0 . "POINT,LWPOLYLINE"))))
     )
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (if (= "POINT" (cdr (assoc 0 (setq el (entget e)))))
	 (setq a (cons (list (cdr (assoc 10 el)) e) a))
	 (setq b (cons (vl-remove-if '(lambda (x) (/= 10 (car x))) el) b))
       )
     )
     (if (setq b (mapcar 'cdr (apply 'append b)))
       (foreach	p a
	 (setq c (mapcar '+ (car p) '(0 0)))
	 (cond
	   ((setq m (vl-some '(lambda (x) (if (equal c x d) x)) b))
	    (setq b (vl-remove m b))
	    (entmod (append (entget (cadr p)) (list (cons 10 (append m (list (last (car p))))))))
	   )
	 )
       )
     )
    )
  )
  (princ)
)

 

 

 

Many thanks, work very well. 

 

 

 

 

[ronjonp]

9 hours ago, whosa said:

 

 

Many thanks, work very well. 

 

 

 

 

[Guest]

is it posible to update this code work with blocks , points and circles ?

 

Thanks

Edited May 6, 2020 by prodromosm

[ronjonp]

9 hours ago, prodromosm said:

is it posible to update this code work with blocks , points and circles ?

 

Thanks

Yup.

(defun c:s2o (/ a b c d el m s)
  ;; RJP » 2020-04-29
  ;; Could give bad results for multiple vertices that are within the 'search distance'
  (cond
    ((and (setq d (getdist "\nPick a distance to search: "))
	  (setq s (ssget ":L" (list '(0 . "CIRCLE,INSERT,POINT,LWPOLYLINE"))))
     )
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (if (= "LWPOLYLINE" (cdr (assoc 0 (setq el (entget e)))))
	 (setq b (cons (vl-remove-if '(lambda (x) (/= 10 (car x))) el) b))
	 (setq a (cons (list (cdr (assoc 10 el)) e) a))
       )
     )
     (if (setq b (mapcar 'cdr (apply 'append b)))
       (foreach	p a
	 (setq c (mapcar '+ (car p) '(0 0)))
	 (cond
	   ((setq m (vl-some '(lambda (x)
				(if (equal c x d)
				  x
				)
			      )
			     b
		    )
	    )
	    (setq b (vl-remove m b))
	    (entmod (append (entget (cadr p)) (list (cons 10 (append m (list (last (car p))))))))
	   )
	 )
       )
     )
    )
  )
  (princ)
)

 

[Guest]

Thank you ronjonp

[ronjonp]

40 minutes ago, prodromosm said:

Thank you ronjonp

You're welcome.

Be aware that if you use attributed blocks there might be some strange results.

[jbach]

ronjonp, I am trying to get this LISP to work in CIVIL 3D 2021 and it will not allow me to select any Points to move. It will allow me to select blocks but not points. Am I doing something wrong? Any help will be greatly appreciated.

 

Thank you!

[ronjonp]

Post a sample drawing .. are you perhaps moving COGO points?

[jbach]

Here you go. Yes they are COGO points and they are unlocked when trying to move with the LISP.

 

Thank you!

Moving Points.dwg

[ronjonp]

I don't have C3D installed at the moment so cannot troubleshoot this ... sorry.

[BIGAL]

Having been doing Civil work for like 40 years you never move a true cogo point. Why would you not just join the pline to the points re rectang. Ok it wont be a true rectang but close enough.

 

Its almost impossible to put simply  a curved pline through points, we designed roads for years then never went exactly through a series of points they would always be a Best Fit.

 

Look at image in my post above.