lisp to project plan.ref. poly onto 3d polys

[almora92]

Hi all,

I was trying to write a lisp but i'm thinking it's too difficult for my basical knowledge.

shortly, i have:

- 1 plan reference object (2d poly/ lw poly): it represent, for example, the alignment of a road (elevation 0);

- a set of target objects (3d polys/lines): representing 3d sections of the road; they intersect the ref.object in xy plan.

i would like to:

- select the ref object (Selected on snapshot)

- select the set of target objects (green on snapshot)

obtaining a 3d poly that is the projection (along z axis) of the ref object onto the target objects (yellow on snapshot), with vertex on xy intersection point and z from target objects in that point.

note: the ref object has original vertex that are not in the xy intersections with the target objects (as you can see from the snapshot), so the final 3dpoly must have vertex on xy intersection (and z from target object) and vertex on ref object's original vertex xy and interpolated z.

i attach the example.dwg of the snapshot, to clarify the problem.

i'm not very sure this could be done with a lisp: i was looking to solve it with a simple (in my opinion) approach, extracting the vertex coords for each entity, then with a mathematical approach obtaining what i want.

another problem is that some target object could not intersect the ref object (so i think it's very important to add, first of all, a step to filter the intersecting target object to exclude the not intersecting ones).

Hope to start a constructive discussion on the argument, it could improve a lot my workflow, and surelly improve my autolisp coding

Thank you all in advance,

[Moshe-A]

@almora92  hi,

From coding perspective view this is not very hard to do but it would take long time to process 😀

i see some sections (3d plines) that does not cross the reference (2dpline), what are you expecting to happen there?

Moshe

[almora92]

Hi @Moshe-A. Yeah, the 3dpolys (cross sections) are exported by a dtm that could be not continuous, so it happens that some 3dpolys doesn't intersect the ref 2dpoly and/or some cross sections have more than one 3dpolys. What i would like to do is to filter only the intersecting 3dpolys and discard all the not intersecting 3d polys.

When it doesn't find an intersecting 3dpolys, it could z-interpolate only the ref 2dpoly vertex and don't add any xyz intersection vertex till it find the next intersecting cross section.

[Moshe-A]

---

@almora92 wrote:

Hi @Moshe-A. Yeah, the 3dpolys (cross sections) are exported by a dtm that could be not continuous, so it happens that some 3dpolys doesn't intersect the ref 2dpoly and/or some cross sections have more than one 3dpolys. What i would like to do is to filter only the intersecting 3dpolys and discard all the not intersecting 3d polys.

When it doesn't find an intersecting 3dpolys, it could z-interpolate only the ref 2dpoly vertex and don't add any xyz intersection vertex till it find the next intersecting cross section.

---

how about extending the close 3dpoly to the reference object?

[-didier-]

Bonjour @almora92 

Here is the first version of the solution to your question.
For now, I have worked on the intersections of poly 2D and poly 3D by calculating the Z of this virtual intersection.
I am running out of time to finalize with the intermediate interpolations.
I am talking about the extra points on the poly 2D that are not intersections.

Here is the principle and the result, selection of poly 2D and that’s it.

Amicalement

 

[almora92]

it could create an error; given that there aren't too much not intersecting 3dpolys, i was thinking about not using non-intersecting 3dpolys, it could be ok.

[almora92]

bonsoir Didier,
very nice result!
i see that your lisp works only selecting the reference 2dpoly and not selecting the target 3dpolys, i'm right? do you think it's possible to let me choose both, the ref object and the target objects?

[Moshe-A]

@almora92 ,

here is mine 😀 command FINAL3D

first you select the 2d pline.

then select all the 3d plines 

on my regular laptop it took about 30 seconds to calculate this.

did not take care of the broken sections yet.

of course this could not been made without the beautiful function from Lee Mac, thank you very much.

enjoy

Moshe

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)


(defun c:final3d (/ draw_line draw_3dpline ; local function
		    ss0 ss1 AcDb2dPline ename1 AcDb3dPline exploded^ AcDbLine2 AcDbLine3 AcDbLine4 p0 p1 p2 p3 z crs ent lst obj)


 (defun draw_line (t0 t1)
  (entmakex
   (list
    '(0 . "LINE")
    '(100 . "AcDbLine")
    (cons '10 t0)
    (cons '11 t1)
   )
  )
 ); draw_line

  
 (defun draw_3dpline (pt_lst)
  (if (null (tblsearch "layer" "final 3d poly"))
   (command "._layer" "_make" "final 3d poly" "_color" 2 "final 3d poly" "")
  )
   
  (command "._3dpoly")

  (foreach pt pt_lst
   (command "_none" pt)
  )

  (command "")

  (command "._chprop" "_si" "_Last" "_Layer" "final 3d poly" "")
 ); draw_3dpline
  

 ; here start c:final3d
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (if (and
       (not (prompt "\nPick reference 2dpline: "))
       (setq ss0 (ssget ":s:e+." '((0 . "lwpolyline"))))
       (not (prompt "\nselect target 3dpline(s)..."))
       (setq ss1 (ssget '((0 . "polyline") (100 . "AcDb3dPolyline"))))
     )
  (progn
   (setq AcDb2dPline (vlax-ename->vla-object (ssname ss0 0)))
   (foreach ename1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))     
    (setq AcDb3dPline (vlax-ename->vla-object ename1))
    (setq exploded^ (vlax-safearray->list (vlax-variant-value (vla-explode AcDb3dPline))))

    (foreach AcDbLine2 exploded^
     (setq AcDbLine3 (vla-copy AcDbLine2))
     (setq p0 (vlax-safearray->list (vlax-variant-value (vla-get-startpoint AcDbLine3)))) 
     (setq p1 (vlax-safearray->list (vlax-variant-value (vla-get-endpoint AcDbLine3))))

     (setq z (+ 1 (apply 'max (mapcar (function (lambda (pt) (caddr pt))) (list p0 p1)))))

     (vla-put-startpoint AcDbLine3 (vlax-3d-point (list (car p0) (cadr p0) 0.0)))
     (vla-put-endpoint AcDbLine3 (vlax-3d-point (list (car p1) (cadr p1) 0.0)))

     (if (and
	   (setq crs (LM:intersections AcDb2dPline AcDbLine3 acExtendNone))
	   (= (vl-list-length crs) 1)
	 )
      (progn
       (setq p2 (car crs))
       (setq p3 (list (car p2) (cadr p2) z))
       (setq ent (draw_line p2 p3))
       (setq AcDbLine4 (vlax-ename->vla-object ent))
       (if (setq crs (LM:intersections AcDbLine4 AcDbLine2 acExtendNone))
        (setq lst (cons (car crs) lst))
       )

       (vla-delete AcDbLine4)
       (vlax-release-object AcDbLine4)
      ); progn
     ); if

     (vla-delete AcDbLine3)
     (vlax-release-object AcDbLine3)
    ); foreach

    ; dispose memory
    (foreach obj exploded^
     (vla-delete obj)
     (vlax-release-object obj)
    )
   
    (vlax-release-object AcDb3dPline)
   ); foreach

   (vlax-release-object AcDb2dPline)

   (if lst
    (draw_3dpline lst)
   )
  ); progn
 ); if

 (command ".undo" "_end")
 (setvar "cmdecho" 1)

 (princ "\nDone.")
 (princ)  
); c:final3d 

[Sea-Haven]

Here is my answer, CIV3D or Civil Site Design, there are others. Which includes the plotting of the answer which will be the next request.

I think  TriangV.0.6.7.lsp will do a long section also. Extra advantage is makes surfaces.

; C:TIN, Generates Delaunay Triangulation and Voronoi Diagram.               ;
;; C:CONT, Generates Contours from a sset of 3DFACES.                         ;
;; C:GEN, Generates a bunch of points for testing.                            ;
;; C:DEMOZ, Demo of locating yourself in a triangulation.                     ;
;; C:LBL, Generates Label on Major Contour at regular spacing.                ;
;; C:FLBL, Generates Label on All Contours Along Fence Lines.                 ;
;; C:DLBL, Generates Label Dynamically (Based on Alan JT routine)             ;
;; C:PROF, Generates a Longitudinal Profile.                                  ;
;; C:XSHAPE, (Chi-shape) Generates Concave Boundary Around Triangulation      ;
;; C:FLIP, Flip Common Edge Between Two Triangles.  

[-didier-]

Bonjour @almora92 

Yes it is the case, I assumed it was more convenient not to have to select the 3d polylines.

If you can do something complicated, you can do something simple, in French we says "qui peut le plus peut le moins".

I don’t know how to translate it perfectly.
If you really need a selection by the user, it is easily achievable.

Now I have to work on finding a solution to interpolate the additional points of polyline 2D that are not in the vertical of polys 3d.

If I find a solution quickly I deliver the code, otherwise I deliver the current code adding the possibility to select yourself polys3D.

It’s not the right time to work on code, we’re busy preparing for New Year’s Eve.
But at the beginning of the year I will be more available.

NOTE : My solution is quite fast because it makes the minimum call to create entities to calculate points.

Amicalement

[komondormrex]

hey there,

yet another quick one

;*************************************************************************************************************************************************************

; 	3d_projection custom command
;	komondormrex, dec 2024

;*************************************************************************************************************************************************************

(defun find_3d_projection (3d_pline / vertices z_0_vertices projection_point)
 	(setq vertices (vlax-get 3d_pline 'coordinates)
  	      z_0_vertices (mapcar '* vertices (repeat (/ (length vertices) 3) (setq z_0_vertices (append z_0_vertices '(1 1 0)))))
        )
  	(vlax-put 3d_pline 'coordinates z_0_vertices)
	(if (and (setq projection_point (vlax-invoke 3d_pline 'intersectwith ref_2d_pline acextendnone))
		 (= 3 (length projection_point))
	    )
		  (progn
		  	(vlax-put 3d_pline 'coordinates vertices)
		  	(vlax-curve-getclosestpointtoprojection 3d_pline projection_point '(0 0 1))
		  )
		  (progn
		    (vlax-put 3d_pline 'coordinates vertices)
		    nil
		  )
  	)
)

;*************************************************************************************************************************************************************

(defun c:3d_projection (/ ref_2d_pline 3d_profile_sset 3d_projection_points)
  (setq ref_2d_pline (vlax-ename->vla-object (car (entsel "\nPick 2d reference pline:"))))
  (princ "\nSelect 3d profiles to make projection...")
  (setq 3d_profile_sset (ssget '((0 . "polyline") (70 . 8))))
  (if (and ref_2d_pline 3d_profile_sset)
    (progn
      (setq 3d_projection_points
	    (vl-sort
	      	(vl-remove nil (mapcar 'find_3d_projection (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex 3d_profile_sset))))))
	    	'(lambda (point_1 point_2) (< (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_1))
					      (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_2))
					   )
		 )
	    )
      )
      (vla-add3dpoly (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
		     (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (* 3 (length 3d_projection_points))))
		       			  (apply 'append 3d_projection_points)
		     )
      )
    )
  )
)

;*************************************************************************************************************************************************************

[komondormrex · Accepted solution]

with approximation of reference pline's vertices that are not intersected with sections' 3d plines.

;*************************************************************************************************************************************************************

; 	3d_projection custom command
;	komondormrex, jan 2025

;*************************************************************************************************************************************************************

(defun find_3d_projection (3d_pline / vertices z_0_vertices projection_point)
 	(setq vertices (vlax-get 3d_pline 'coordinates)
  	      z_0_vertices (mapcar '* vertices (repeat (/ (length vertices) 3) (setq z_0_vertices (append z_0_vertices '(1 1 0)))))
        )
  	(vlax-put 3d_pline 'coordinates z_0_vertices)
	(if (and (setq projection_point (vlax-invoke 3d_pline 'intersectwith ref_2d_pline acextendnone))
		 (= 3 (length projection_point))
	    )
		  (progn
		  	(vlax-put 3d_pline 'coordinates vertices)
		  	(vlax-curve-getclosestpointtoprojection 3d_pline projection_point '(0 0 1))
		  )
		  (progn
		    (vlax-put 3d_pline 'coordinates vertices)
		    nil
		  )
  	)
)

;*************************************************************************************************************************************************************

(defun c:3d_projection (/ ref_2d_pline ref_2d_vertices 3d_profile_sset 3d_projection_points 3d_poly 3d_poly_flattened z_0_vertices vertices)
  (setq ref_2d_pline (vlax-ename->vla-object (setq 2d_pline (car (entsel "\nPick 2d reference pline:"))))
	ref_2d_vertices (mapcar 'cdr (vl-remove-if-not '(lambda (group) (= 10 (car group))) (entget 2d_pline)))
  )
  (princ "\nSelect 3d profiles to make projection...")
  (setq 3d_profile_sset (ssget '((0 . "polyline") (70 . 8))))
  (if (and ref_2d_pline 3d_profile_sset)
    (progn
      (setq 3d_projection_points
	    (vl-sort
		(vl-remove nil (mapcar 'find_3d_projection (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex 3d_profile_sset))))))
	    	'(lambda (point_1 point_2) (< (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_1))
					      (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_2))
					   )
		 )
	    )
	    3d_poly (vla-add3dpoly (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
				   (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (* 3 (length 3d_projection_points))))
				       			(apply 'append 3d_projection_points)
				   )
		    )
	    3d_poly_flattened (vla-copy 3d_poly)
	    vertices (vlax-get 3d_poly_flattened 'coordinates)
      )
      (vlax-put 3d_poly_flattened 'coordinates (mapcar '* vertices (repeat (/ (length vertices) 3) (setq z_0_vertices (append z_0_vertices '(1 1 0))))))
      (setq 3d_projection_points (vl-sort (append 3d_projection_points
				   	 	  (mapcar '(lambda (vertex) (list (car vertex)
										  (cadr vertex)
										  (caddr (vlax-curve-getclosestpointtoprojection 3d_poly (vlax-curve-getclosestpointto 3d_poly_flattened vertex) '(0 0 1)))
									    )
							   )
							   ref_2d_vertices
						  )
					  )
					 '(lambda (point_1 point_2) (< (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_1))
					      	  		       (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_2))
					  			    )
		 			  )
				  )
      )
      (vlax-put 3d_poly 'coordinates (apply 'append 3d_projection_points))
      (vla-put-color 3d_poly 2) 
      (vla-erase 3d_poly_flattened) 
    )
  )
  (princ)
)

;*************************************************************************************************************************************************************

[almora92]

That's what i was looking (and trying to coding) for. 
Now i will spend my free time trying to study your code and, hopefully, comparing it with the other solutions that have arrived/will arrive.

The first improvement i would like to do is to allow the selection of multiple reference polylines at the same time, so that if I wanted to project multiple polylines I can do it in one step.

[komondormrex · Accepted solution]

---

@almora92 wrote:

i would like to do is to allow the selection of multiple reference polylines at the same time

---

check  the following, uses et thou to indicate processing.

;*************************************************************************************************************************************************************

; 	3d_projection custom command
;	komondormrex, jan 2025

;*************************************************************************************************************************************************************

(defun find_3d_projection (3d_pline / vertices z_0_vertices projection_point)
 	(setq vertices (vlax-get 3d_pline 'coordinates)
  	      z_0_vertices (mapcar '* vertices (repeat (/ (length vertices) 3) (setq z_0_vertices (append z_0_vertices '(1 1 0)))))
        )
  	(vlax-put 3d_pline 'coordinates z_0_vertices)
	(if (and (setq projection_point (vlax-invoke 3d_pline 'intersectwith ref_2d_pline acextendnone))
		 (= 3 (length projection_point))
	    )
		  (progn
		  	(vlax-put 3d_pline 'coordinates vertices)
		  	(vlax-curve-getclosestpointtoprojection 3d_pline projection_point '(0 0 1))
		  )
		  (progn
		    (vlax-put 3d_pline 'coordinates vertices)
		    nil
		  )
  	)
)

;*************************************************************************************************************************************************************

(defun pline_3d_projection (pline / ref_2d_pline ref_2d_vertices 3d_projection_points 3d_poly 3d_poly_flattened z_0_vertices vertices)
  (setq ref_2d_pline (vlax-ename->vla-object pline)
	ref_2d_vertices (mapcar 'cdr (vl-remove-if-not '(lambda (group) (= 10 (car group))) (entget pline)))
        3d_projection_points
	    (vl-sort
		(vl-remove nil (mapcar 'find_3d_projection (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex 3d_profile_sset))))))
	    	'(lambda (point_1 point_2) (< (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_1))
					      (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_2))
					   )
		 )
	    )
  )
  (if (and 3d_projection_points (< 1 (length 3d_projection_points)))
    (progn
	(setq 3d_poly (vla-add3dpoly (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
			         (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (* 3 (length 3d_projection_points))))
			       			      (apply 'append 3d_projection_points)
			         )
	    	  )
	  3d_poly_flattened (vla-copy 3d_poly)
	  vertices (vlax-get 3d_poly_flattened 'coordinates)
	)
	(vlax-put 3d_poly_flattened 'coordinates (mapcar '* vertices (repeat (/ (length vertices) 3) (setq z_0_vertices (append z_0_vertices '(1 1 0))))))
	(setq 3d_projection_points (vl-sort (append 3d_projection_points
			   	 	      (mapcar '(lambda (vertex) (list (car vertex)
									      (cadr vertex)
									      (caddr (vlax-curve-getclosestpointtoprojection
										       	3d_poly
											(vlax-curve-getclosestpointto 3d_poly_flattened vertex)
											'(0 0 1))
									      )
								    	)
						       )
						       ref_2d_vertices
					      )
				      )
				     '(lambda (point_1 point_2) (< (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_1))
				      	  		           (vlax-curve-getparamatpoint ref_2d_pline (mapcar '* '(1 1) point_2))
				  			        )
	 			      )
			     )
	)
	(vlax-put 3d_poly 'coordinates (apply 'append 3d_projection_points))
	(vla-put-color 3d_poly 2) 
	(vla-erase 3d_poly_flattened)
    )
  )
)

;*************************************************************************************************************************************************************

(defun c:3d_projection (/ 2d_ref_pline_sset 3d_profile_sset index)
  (setq index 0)
  (princ "\nSelect 2d reference plines...")
  (setq 2d_ref_pline_count (sslength (setq 2d_ref_pline_sset (ssget '((0 . "lwpolyline"))))))
  (princ "\nSelect 3d profiles to make projection...\n")
  (setq 3d_profile_sset (ssget '((0 . "polyline") (70 . 8))))
  (if (and 2d_ref_pline_sset 3d_profile_sset)
    (progn
	(acet-ui-progress "Processing...")
	(foreach pline (vl-remove-if 'listp (mapcar 'cadr (ssnamex 2d_ref_pline_sset)))
		(pline_3d_projection pline)
	)
    	(acet-ui-progress-done)
    )
  )
  (princ)
)

;*************************************************************************************************************************************************************

[-didier-]

Bonjour @almora92 

Here is my proposition.

I left the automatic choice of poly 3d.
So you can study several versions.
However, I do not sort, I work with your example and only need the poly 2d and poly 3d visual on screen.
Let me know if you have any questions.

The command name is TEST.

Amicalement