Creating points at 3D polyline intersections

Creating points at 3D polyline intersections

oli-123
Contributor Contributor
5,916 Views
10 Replies
Message 1 of 11

Creating points at 3D polyline intersections

oli-123
Contributor
Contributor

Hello everyone,

I've found a great piece of AutoLISP routine from Lee Mac's website that helps me create a point at every intersection. However, it doesn't seem to work when I have many polylines at different elevations. How should the code be modified? I can't really flatten them since I want the points to be snapped to the elevated lines.

 

(In the attached sample drawing, the 2D yellow lines are at elevation 0, and the white lines are at different elevations. The points should be snapped to where they intersect, at the white lines' elevations.)

 

 

 

(defun c:intersets ( / ss1 ss2 )
    (if (and (setq ss1 (ssget))
             (setq ss2 (ssget))
        )
        (foreach pnt (LM:intersectionsbetweensets ss1 ss2)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        )
    )
    (princ)
)
(vl-load-com) (princ)


;; Intersections Between Sets  -  Lee Mac
;; Returns a list of all points of intersection between objects in two selection sets.
;; ss1,ss2 - [sel] Selection sets

(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)


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

 

 

 

0 Likes
Accepted solutions (1)
5,917 Views
10 Replies
Replies (10)
Message 2 of 11

hak_vz
Advisor
Advisor

Two object intersect if they lie in same plane.

 

Since your lwpolylines have different elevations they don't intersect i.e there is only apparent intersection.

To find intersections create in separate layer copy of lwpolylines but with elevation set to 0 and find points of intersection in plane  Z = 0. Use that set of points and create vertical lines with start point x,y,0, and end point let say x,y,1000. In second run look for intersection of vertical lines and original lwpolylines to receive 3d point of intersection.

 

 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 3 of 11

Kent1Cooper
Consultant
Consultant

The (intersectwith) method isn't going to do you any good if they don't actually intersect in 3D space.  I suggest that you just set APParent-Intersection mode as the only running Osnap mode, call up MULTIPLE and the POINT command, and go around picking at the apparent intersections.  I suspect it would be a lot faster than coming up with a way of making flattened copies, finding intersections with those, generating vertical Lines, and finding the actual intersections of those with the original raised-Z Polylines.  You'll need to Zoom in to get multiple APParent Intersections where white Polylines are very close to each other.

 

HOWEVER, I'm not sure what determines at which object's elevation a Point goes under APParent-Intersection Osnap mode.  In my quickie trial, they all went to the elevations at the white sloped ones, but it may be always at the place on the more-recently-drawn  of the objects involved.  That's always the white compared to the yellow in your sample drawing, but might not always be.

 

[And by the way, these shouldn't be drawn in Paper Space.]

Kent Cooper, AIA
0 Likes
Message 4 of 11

oli-123
Contributor
Contributor

@Kent1Cooper wrote:

HOWEVER, I'm not sure what determines at which object's elevation a Point goes under APParent-Intersection Osnap mode.  In my quickie trial, they all went to the elevations at the white sloped ones, but it may be always at the place on the more-recently-drawn  of the objects involved.  That's always the white compared to the yellow in your sample drawing, but might not always be.


It seems like whichever is the top-most object, the apparent intersection will snap to that object's elevation.

 


@Kent1Cooper wrote:

[And by the way, these shouldn't be drawn in Paper Space.]


Oops, my bad. I was too hasty to make the sample drawing.

 

It seems like there's no easy way to make it work by replacing a few commands. It would be best if I can reduce as much manual work as possible since my actual drawing contains thousands of intersections that are at different elevations.

0 Likes
Message 5 of 11

hak_vz
Advisor
Advisor

If you only use lwpolylines, i.e in intersections there is no inclined lines or 3dpolylines then solution is simple.

To find an intersection read elevation from lwpoly object, create line object elevated to that Z, find intersection with lwpoly, and create a point. Then erase line object.

 

Please elaborate what you want to do with that points. Cross sections?

 

 

 

 

 

 

 

 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 6 of 11

oli-123
Contributor
Contributor

I would be creating a label for each one of those points and display their elevation values.

 

I see what you're saying now. It's not as neat as what I would imagine, but that's one thing I can do. I'll have to try that out.

0 Likes
Message 7 of 11

hosneyalaa
Advisor
Advisor
;;  3DPolyInters.lsp by Trevor Bird
;;        https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/intersections-between-3dpoly/td-p/7719713?fbclid=IwAR2A2cVBPzWES2-hpAiSttQ_scxVZaCpViM3PAJHC8sIThnQ1G_BWK2qmyg
;;  2018-01-25

;;------------------------------------------------------------------------------
(defun c:3dpolyinters
  (
    /

    Block_Name

    color_int
    col_Block
    col_Blocks
    Coordinates1_list
    Coordinates1_sa
    Coordinates1_var
    Coordinates2_list
    Coordinates2_sa
    Coordinates2_var
    Coordinates3_list
    Coordinates3_sa
    Coordinates3_var
    Coordinates4_list
    Coordinates4_sa
    Coordinates4_var

    dps_Params1
    dps_Params2

    EndParam1
    EndParam2

    flag_Intersects

    Inters1_list
    Inters1_Point
    Inters1_sa
    Inters1_var

    list_params1
    list_params2

    Objects1_sa
    Objects2_list
    Objects2_var
    obj_AD
    obj_POLYLINE1
    obj_POLYLINE1:2D
    obj_POLYLINE1:3D
    obj_POLYLINE2
    obj_POLYLINE2:2D
    obj_POLYLINE2:3D

    Param1
    Param2
    ParamAtPoint1
    ParamAtPoint2
    PointAtParam1:3D
    PointAtParam1_list
    PointAtParam2:3D
    PointAtParam2_list
    POLYLINE1_ename
    POLYLINE2_ename

    ssC1
    ssC2
    ss_Filter
    ss_length1
    ss_length2
    ss_modified
    ss_POLYLINES
    StartParam1
    StartParam2
    sv_cvport
  )
  (setq obj_AD      (vlax-get-property (vlax-get-acad-object) 'ActiveDocument)
        col_Blocks  (vlax-get-property obj_AD 'Blocks)

        sv_cvport   (getvar 'CVPORT)
  );setq

  (setq ss_Filter
    '(
      (0 . "POLYLINE")
      (-4 . "&=")
      (70 . 8)
    );'
  );setq

  (if (= sv_cvport 1)
    (setq ss_Filter  (append ss_Filter (list (cons 410 (getvar 'CTAB)))))
    (setq ss_Filter  (append ss_Filter '((410 . "Model"))))
  );if (= sv_cvport 1)




  (setq ss_POLYLINES  (ssget ":L" ss_Filter))

  (cond
    ( (not ss_POLYLINES)
      (princ "\nNo Polylines selected.")
    );(not ss_POLYLINES)


    (ss_POLYLINES
      ;;  <!--
      ;;  Do intersection processing inside a block definition so that construction geometry can be easily managed and deleted.
      (setq Block_Name  "3DPolyInters_DELETE_ME")

      (cond
        ( (not (tblsearch "BLOCK" Block_Name))
          (setq col_Block  (vlax-invoke-method col_Blocks 'Add (vlax-3D-point '(0.0 0.0 0.0)) Block_Name))

          (vlax-put-property col_Block 'BlockScaling acUniform)
          (vlax-put-property col_Block 'Explodable :vlax-true)
          (vlax-put-property col_Block 'Units (getvar 'InsUnits))
        )

        (T
          (setq col_Block  (vlax-invoke-method col_Blocks 'Item Block_Name))

          (vlax-for vf::objectcb col_Block
            (vlax-invoke-method vf::objectcb 'Delete)
          );vf::objectcb
        );T
      );cond
      ;;  -->


      (setq ssC1         -1
            ss_length1   (sslength ss_POLYLINES)
            color_int    0
            ss_modified  (ssadd)
      );setq

      (repeat ss_length1
        (setq POLYLINE1_ename    (ssname ss_POLYLINES (setq ssC1  (1+ ssC1)))
              obj_POLYLINE1      (vlax-ename->vla-object POLYLINE1_ename)

              color_int          (1+ color_int)

              StartParam1        (vlax-curve-getStartParam obj_POLYLINE1)
              EndParam1          (vlax-curve-getEndParam obj_POLYLINE1)
              Param1             StartParam1
              dps_Params1        nil
              Coordinates1_list  nil
        );setq

        (repeat (1+ (fix EndParam1))
          (setq PointAtParam1_list  (vlax-curve-getPointAtParam obj_POLYLINE1 Param1)
                dps_Params1         (append dps_Params1 (list (cons Param1 PointAtParam1_list)))
                Coordinates1_list   (append Coordinates1_list (list (car PointAtParam1_list) (cadr PointAtParam1_list) 0.0))
                Param1              (+ Param1 1.0)
          );setq
        );repeat (1+ (fix EndParam1))


        ;;  <!-- Copy obj_POLYLINE1 into block created for intersection processing geometry.
        (setq Objects1_sa  (vlax-make-safearray vlax-vbObject '(0 . 0)))

        (vlax-safearray-fill Objects1_sa (list obj_POLYLINE1))

        (setq Objects2_var      (vlax-invoke-method obj_AD 'CopyObjects Objects1_sa col_Block)
              Objects2_list     (vlax-safearray->list (vlax-variant-value Objects2_var))
              obj_POLYLINE1:2D  (car Objects2_list)
              obj_POLYLINE1:3D  (vlax-invoke-method obj_POLYLINE1:2D 'Copy)
        );setq


        ;;  Flatten obj_POLYLINE1:2D i.e. Z = 0.0
        (setq Coordinates1_sa  (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length Coordinates1_list)))))

        (vlax-safearray-fill Coordinates1_sa Coordinates1_list)

        (setq Coordinates1_var  (vlax-make-variant Coordinates1_sa (logior vlax-vbArray vlax-vbDouble)))

        (vlax-put-property obj_POLYLINE1:2D 'Coordinates Coordinates1_var)
        (vlax-invoke-method obj_POLYLINE1:2D 'Update)
        ;;  -->


        ;;  <!-- Check for intersections with obj_POLYLINE1 and the rest of the 3D polylines selected.
        (setq ss_length2       (- ss_length1 (1+ ssC1))
              ssC2             ssC1
              flag_Intersects  nil
        );setq

        (repeat ss_length2
          (setq POLYLINE2_ename    (ssname ss_POLYLINES (setq ssC2  (1+ ssC2)))
                obj_POLYLINE2      (vlax-ename->vla-object POLYLINE2_ename)

                StartParam2        (vlax-curve-getStartParam obj_POLYLINE2)
                EndParam2          (vlax-curve-getEndParam obj_POLYLINE2)
                Param2             StartParam2
                dps_Params2        nil

                Coordinates2_list  nil
          );setq

          (repeat (1+ (fix EndParam2))
            (setq PointAtParam2_list  (vlax-curve-getPointAtParam obj_POLYLINE2 Param2)
                  dps_Params2         (append dps_Params2 (list (cons Param2 PointAtParam2_list)))
                  Coordinates2_list   (append Coordinates2_list (list (car PointAtParam2_list) (cadr PointAtParam2_list) 0.0))
                  Param2              (+ Param2 1.0)
            );setq
          );repeat (1+ (fix EndParam2))


          ;;  <!-- Copy obj_POLYLINE2 into block created for intersection processing geometry.
          (setq Objects1_sa (vlax-make-safearray vlax-vbObject '(0 . 0)))

          (vlax-safearray-fill Objects1_sa (list obj_POLYLINE2))

          (setq Objects2_var      (vlax-invoke-method obj_AD 'CopyObjects Objects1_sa col_Block)
                Objects2_list     (vlax-safearray->list (vlax-variant-value Objects2_var))
                obj_POLYLINE2:2D  (car Objects2_list)
                obj_POLYLINE2:3D  (vlax-invoke-method obj_POLYLINE2:2D 'Copy)
          );setq


          ;;  Flatten obj_POLYLINE2:2D i.e. Z = 0.0
          (setq Coordinates2_sa  (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length Coordinates2_list)))))

          (vlax-safearray-fill Coordinates2_sa Coordinates2_list)

          (setq Coordinates2_var  (vlax-make-variant Coordinates2_sa (logior vlax-vbArray vlax-vbDouble)))

          (vlax-put-property obj_POLYLINE2:2D 'Coordinates Coordinates2_var)
          (vlax-invoke-method obj_POLYLINE2:2D 'Update)
          ;;  -->


          ;;  <!-- Check for intersection.
          (setq Inters1_var  (vlax-invoke-method obj_POLYLINE1:2D 'IntersectWith obj_POLYLINE2:2D acExtendNone)
                Inters1_sa   (vlax-variant-value Inters1_var)
          );setq

          (cond
            (  (not (minusp (vlax-safearray-get-u-bound Inters1_sa 1)))
              ;;  Intersects.
              (setq Inters1_list     (vlax-safearray->list Inters1_sa)
                    flag_Intersects  T
              );setq

              (while Inters1_list
                (setq Inters1_Point  nil)

                (repeat 3
                  (setq Inters1_Point  (append Inters1_Point (list (car Inters1_list)))
                        Inters1_list   (cdr Inters1_list)
                  );setq
                );repeat 3

                (setq ParamAtPoint1     (vlax-curve-getparamatpoint obj_POLYLINE1:2D Inters1_Point)
                      ParamAtPoint2     (vlax-curve-getparamatpoint obj_POLYLINE2:2D Inters1_Point)

                      PointAtParam1:3D  (vlax-curve-getpointatparam obj_POLYLINE1:3D ParamAtPoint1)
                      PointAtParam2:3D  (vlax-curve-getpointatparam obj_POLYLINE2:3D ParamAtPoint2)
                );setq

                (if (not (assoc ParamAtPoint1 dps_Params1))
                  (setq dps_Params1  (append dps_Params1 (list (cons ParamAtPoint1 PointAtParam1:3D))))
                );if

                (if (not (assoc ParamAtPoint2 dps_Params2))
                  (setq dps_Params2  (append dps_Params2 (list (cons ParamAtPoint2 PointAtParam2:3D))))
                );if
              );while Inters1_list
              ;;  -->


              ;;  <!-- Reconstruct obj_POLYLINE2 3D polyline vertices to include additional vertices at intersections.
              ;;  Sort dps_Params2 in numerical order.
              (setq list_params2       (mapcar 'car dps_Params2)
                    list_params2       (vl-sort list_params2 '<)
                    dps_Params2        (mapcar '(lambda (_param2) (assoc _param2 dps_Params2)) list_params2)
                    Coordinates3_list  (apply 'append (mapcar 'cdr dps_Params2))
                    Coordinates3_sa    (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length Coordinates3_list))))
              );setq

              (vlax-safearray-fill Coordinates3_sa Coordinates3_list)

              (setq Coordinates3_var  (vlax-make-variant Coordinates3_sa (logior vlax-vbArray vlax-vbDouble)))

              (vlax-put-property obj_POLYLINE2 'Coordinates Coordinates3_var)
              (vlax-invoke-method obj_POLYLINE2 'Update)

              (ssadd POLYLINE2_ename ss_modified)
              ;;  -->
            )

            (T
              ;;  No intersections.
            );T
          );cond


          (vlax-invoke-method obj_POLYLINE2:2D 'Delete)
          (vlax-invoke-method obj_POLYLINE2:3D 'Delete)

          (vlax-release-object obj_POLYLINE2:2D)
          (vlax-release-object obj_POLYLINE2:3D)


          (vlax-release-object obj_POLYLINE2)
        );repeat ss_length2


        ;;  Delete copied geometry from processing block.
        (vlax-invoke-method obj_POLYLINE1:2D 'Delete)
        (vlax-invoke-method obj_POLYLINE1:3D 'Delete)
        (vlax-release-object obj_POLYLINE1:2D)
        (vlax-release-object obj_POLYLINE1:3D)
        ;;  -->


        ;;  <!-- Reconstruct obj_POLYLINE1 3D polyline vertices to include additional vertices at intersections.
        (if flag_Intersects
          (progn
            ;;  Sort dps_Params1 in numerical order.
            (setq list_params1       (mapcar 'car dps_Params1)
                  list_params1       (vl-sort list_params1 '<)
                  dps_Params1        (mapcar '(lambda (_param1) (assoc _param1 dps_Params1)) list_params1)
                  Coordinates4_list  (apply 'append (mapcar 'cdr dps_Params1))
                  Coordinates4_sa    (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length Coordinates4_list))))
            );setq

            (vlax-safearray-fill Coordinates4_sa Coordinates4_list)

            (setq Coordinates4_var  (vlax-make-variant Coordinates4_sa (logior vlax-vbArray vlax-vbDouble)))

            (vlax-put-property obj_POLYLINE1 'Coordinates Coordinates4_var)
            (vlax-invoke-method obj_POLYLINE1 'Update)

            ;;  For testing change color of obj_POLYLINE1.
;            (vlax-put-property obj_POLYLINE1 'Color color_int)

            (ssadd POLYLINE1_ename ss_modified)
          );progn
        );if flag_Intersects
        ;;  -->


        (vlax-release-object obj_POLYLINE1)
      );repeat ss_length1


      ;;  "Purge" intersection processing block.
      (vlax-invoke-method col_Block 'Delete)

      (vlax-release-object col_Block)


      ;;  Grip and select.
      (sssetfirst nil ss_modified)
    );ss_POLYLINES
  );cond


  (vlax-release-object col_Blocks)
  (vlax-release-object obj_AD)


  (princ)
);c:3dpolyinters




;;------------------------------------------------------------------------------
(princ "\n3DPolyInters loaded. Start command with 3DPOLYINTERS.")
(princ)
0 Likes
Message 8 of 11

Sea-Haven
Mentor
Mentor

A quick and dirty is to use trim then get new end point save value, then undo to put back, not extensively tested. 

 

Noticed your dwg has two lines at crossing yellow lines.

0 Likes
Message 9 of 11

trevor.bird.au
Advocate
Advocate
Accepted solution

Hi oli6QAF7,

 

Please try the following code which will determine the intersection point on the elevated polyline and insert a POINT object at the coordinate:

;;  PolyInters.lsp by Trevor Bird
;;
;;  2020-08-15

;;------------------------------------------------------------------------------
(defun c:polyinters
  (
    /

    Block_Name

    col_ActiveBlock
    col_Block
    col_Blocks
    Coordinates_flat_list
    Coordinates_list
    Coordinates_sa
    Coordinates_var

    dps_Coordinates

    EndParam

    flag_Intersects

    Inters_list
    Inters_Point
    Inters_sa
    Inters_var

    list_obj_polylines
    list_polylines_elevated
    list_polylines_zero
    list_ss_polylines
    list_Z_elevated

    Objects_sa
    Objects_var
    obj_AD
    obj_point
    obj_polyline
    obj_polyline_flat

    Param
    ParamAtPoint
    PointAtParam_3D
    PointAtParam_list
    polyline_ObjectID

    ss_Filter
    ss_Filter1
    ss_polylines
    StartParam
    sv_cvport
  )
  (setq obj_AD      (vlax-get-property (vlax-get-acad-object) 'ActiveDocument)
        col_Blocks  (vlax-get-property obj_AD 'Blocks)

        sv_cvport   (getvar 'CVPORT)
  );setq


  (if (= sv_cvport 1)
    (setq col_ActiveBlock  (vlax-get-property obj_AD 'PaperSpace)
          ss_Filter        (list (cons 410 (getvar 'CTAB)))
    );setq
    (setq col_ActiveBlock  (vlax-get-property obj_AD 'ModelSpace)
          ss_Filter        '((410 . "Model"))
    );setq
  );if (= sv_cvport 1)


  (setq ss_Filter1
    (append
      '(
        (0 . "*POLYLINE")
      );'
      ss_Filter
    );append
  );setq


  (setq ss_polylines  (ssget ":L" ss_Filter1))

  (cond
    (  (not ss_polylines)
      (princ "\nNo Polylines selected.")
    );(not ss_polylines)

    (ss_polylines
      ;;  <!--
      ;;  Do intersection processing inside a block definition so that construction geometry can be easily managed and deleted.
      (setq Block_Name  "PolyInters_DELETE_ME")

      (cond
        (  (not (tblsearch "BLOCK" Block_Name))
          (setq col_Block  (vlax-invoke-method col_Blocks 'Add (vlax-3D-point '(0.0 0.0 0.0)) Block_Name))

          (vlax-put-property col_Block 'BlockScaling acUniform)
          (vlax-put-property col_Block 'Explodable :vlax-true)
          (vlax-put-property col_Block 'Units (getvar 'INSUNITS))
        )

        (T
          (setq col_Block  (vlax-invoke-method col_Blocks 'Item Block_Name))

          (vlax-for vf__objectcb col_Block
            (vlax-invoke-method vf__objectcb 'Delete)
          );vf__objectcb
        );T
      );cond
      ;;  -->


      ;;  Credit to Kerry Brown (KWBrown) for his code for converting a selection set to a list of objects
      (setq list_ss_polylines   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss_polylines)))
            list_obj_polylines  (mapcar 'vlax-ename->vla-object list_ss_polylines)
      );setq

      ;;  Copy list_obj_polylines into block created for intersection processing geometry.
      (setq Objects_sa  (vlax-make-safearray vlax-vbObject (cons 0 (1- (length list_obj_polylines)))))

      (vlax-safearray-fill Objects_sa list_obj_polylines)

      (setq Objects_var              (vlax-invoke-method obj_AD 'CopyObjects Objects_sa col_Block)
            ;;  Reset list_obj_polylines to the copy of polylines in the block
            list_obj_polylines       (vlax-safearray->list (vlax-variant-value Objects_var))
            list_polylines_zero      nil
            list_polylines_elevated  nil
            dps_Coordinates          nil
      );setq


      ;;  Create 2 lists of polylines for intersection processing:
      ;;    list_polylines_zero        - Polyline with 0 elevation
      ;;    list_polylines_elevated    - Elevated polylines
      (while list_obj_polylines
        (setq obj_polyline        (car list_obj_polylines)
              list_obj_polylines  (cdr list_obj_polylines)
              polyline_ObjectID   (vlax-get-property obj_polyline 'ObjectID)

              ;;  Vertex coordinates of polyline
              StartParam          (vlax-curve-getStartParam obj_polyline)
              EndParam            (vlax-curve-getEndParam obj_polyline)
              Param               StartParam
              Coordinates_list    nil
        );setq

        (repeat (1+ (fix EndParam))
          (setq PointAtParam_list (vlax-curve-getPointAtParam obj_polyline Param)
                Coordinates_list  (append Coordinates_list (list PointAtParam_list))
                Param             (+ Param 1.0)
          );setq
        );repeat (1+ (fix EndParam))


        ;;  Create a list of each polyline's coordinates and its ObjectID for retrieval during intersection processing.
        (setq dps_Coordinates    (append dps_Coordinates (list (cons polyline_ObjectID Coordinates_list)))
              list_Z_elevated    (vl-remove-if '(lambda ( _point ) (zerop (caddr _point))) Coordinates_list)
        );setq

        (cond
          (  (not list_Z_elevated)
            ;;  Polyline with 0 elevation
            (setq list_polylines_zero  (append list_polylines_zero (list obj_polyline)))
          );(not list_Z_elevated)

          (list_Z_elevated
            ;;  Elevated polyline
            (setq list_polylines_elevated  (append list_polylines_elevated (list obj_polyline)))
          );list_Z_elevated
        );cond
      );while list_obj_polylines


      ;;  Process list_polylines_zero for intersection(s) with list_polylines_elevated
      (foreach fe__obj_polyline_zero list_polylines_zero
        (foreach fe__obj_polyline_elevated list_polylines_elevated
          (setq polyline_ObjectID     (vlax-get-property fe__obj_polyline_elevated 'ObjectID)
                Coordinates_list      (cdr (assoc polyline_ObjectID dps_Coordinates))
                obj_polyline_flat     (vlax-invoke-method fe__obj_polyline_elevated 'Copy)

                Coordinates_flat_list (mapcar '(lambda ( _point ) (mapcar '* _point '(1.0 1.0 0.0))) Coordinates_list)
                Coordinates_list      (apply 'append Coordinates_flat_list)

                ;;  Flatten obj_polyline_flat i.e. Z = 0.0
                Coordinates_sa        (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length Coordinates_list))))
          );setq

          (vlax-safearray-fill Coordinates_sa Coordinates_list)

          (setq Coordinates_var  (vlax-make-variant Coordinates_sa (logior vlax-vbArray vlax-vbDouble)))


          ;;  <!--  Flatten obj_polyline_flat
          (vlax-put-property obj_polyline_flat 'Coordinates Coordinates_var)

          ;;  Elevation is NOT a property of a 3D polyline
          (if (vlax-property-available-p obj_polyline_flat 'Elevation)
            (vlax-put-property obj_polyline_flat 'Elevation 0.0)
          );if

          (vlax-invoke-method obj_polyline_flat 'Update)
          ;;  -->


          ;;  <!-- Check for intersection.
          (setq Inters_var (vlax-invoke-method fe__obj_polyline_zero 'IntersectWith obj_polyline_flat acExtendNone)
                Inters_sa  (vlax-variant-value Inters_var)
          );setq

          (cond
            (  (not (minusp (vlax-safearray-get-u-bound Inters_sa 1)))
              ;;  Intersects.
              (setq Inters_list      (vlax-safearray->list Inters_sa)
                    flag_Intersects  T
              );setq

              (while Inters_list
                (setq Inters_Point  nil)

                (repeat 3
                  (setq Inters_Point  (append Inters_Point (list (car Inters_list)))
                        Inters_list   (cdr Inters_list)
                  );setq
                );repeat 3

                (setq ParamAtPoint    (vlax-curve-getparamatpoint obj_polyline_flat Inters_Point)
                      PointAtParam_3D (vlax-curve-getpointatparam fe__obj_polyline_elevated ParamAtPoint)
                      obj_point       (vlax-invoke-method col_ActiveBlock 'AddPoint (vlax-3D-point PointAtParam_3D))
                );setq

                (vlax-release-object obj_point)
              );while Inters_list
              ;;  -->
            )

            (T
              ;;  No intersections.
            );T
          );cond

          (vlax-invoke-method obj_polyline_flat 'Delete)
          (vlax-release-object obj_polyline_flat)
        );fe__obj_polyline_elevated
      );fe__obj_polyline_zero


      ;;  "Purge" intersection processing block.
      (vlax-invoke-method col_Block 'Delete)
    );ss_polylines
  );cond


  (vlax-release-object col_ActiveBlock)
  (vlax-release-object col_Blocks)
  (vlax-release-object obj_AD)

  (princ)
);c:polyinters




;;------------------------------------------------------------------------------
(princ "\nPolyInters loaded. Start command with POLYINTERS.")
(princ)

 PolyInters.gif

 

Regards,

Trevor

Message 10 of 11

oli-123
Contributor
Contributor

Oh wow, this works really well! I tried that on my main drawing, and I'm really happy with the result. Way better than what I tried to attempt.

 

Many thanks to everyone else for other suggestions. 

0 Likes
Message 11 of 11

3dwannab
Advocate
Advocate

Hi Trevor, I tried to see in the code where if there's a 3D Polyline that lies at 0 on the Z axis then there's no intersection. Is this an easy fix? See attached drawing where the bottom 3D Polyline of  the kerb line is at Z = 0. 

 

Many thanks for sharing the code.

 

EDIT: Also would it be difficult to allow the selection of LWPOLYLINES that have an elevation and get the intersection? As all of our topo surveys come in with contours as LWPOLYLINES.

0 Likes