ARRAY-VERTICES on 3D Polyline

[pyou]

Hi 

 

Is there a way to modify this lisp to make it also work on 3D Polylines?

 

(DEFUN C:ARRAY-VERTICES (/ *error* add_vtx in interval pl pt LSE CNT)


  (defun *error* (s)
    (or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*") (prompt (strcat "\nError: " s)))
    (setq LSE nil)
    (princ)
  ) ;;*error*


  (defun add_vtx (add_pt ent_name / obj pct)
    (setq   obj (vlax-ename->vla-object ent_name)
            pct (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)
    )
    (vla-addvertex
      obj
      (1+ (fix add_pt))
      (vlax-make-variant
        (vlax-safearray-fill
          (vlax-make-safearray vlax-vbdouble (quote (0 . 1)))
          (list (car pct) (cadr pct))
        )
      )
    )
  ) ;;add_vtx


;;Main
  (initget 15)
  (setq LSE       (ssget (list (quote  (0 . "LWPOLYLINE"))))
        interval  (getdist "\nSpecify interval: ")
        in        interval
        CNT       0
  )
  (while (< CNT (sslength LSE))
    (setq pl (ssname LSE CNT))
    (while (setq pt (vlax-curve-getpointatdist pl interval))
      (command "_.POINT" pt) ;;Test!
      (add_vtx (vlax-curve-getparamatpoint pl (vlax-curve-getclosestpointto pl pt)) pl)
      (setq interval (+ interval in))
    )
    (setq   interval  in
            CNT       (1+ CNT)
    )
  )
  (setq LSE nil)
  (princ)
) ;;C:ARRAY-VERTICES
(vl-load-com)

 

 

Thank you

[Steven P]

The basic method used in this routine only works on 2d polylines, to make this more versatile and work on 3d polylines and 2d polyline would need this part re-written. Not a quick fix though

[pyou]

it would be great if it could work on 3d Polylines only.

[Tsuky]

Hi,

Try this for 3dPolyline

(defun l-coor2l-pt (obj lst flag / )
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (if flag
          (+ (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0) (caddr lst))
          (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0)
        )
      )
      (l-coor2l-pt obj (if flag (cdddr lst) (cddr lst)) flag)
    )
  )
)
(defun c:add_vertex-3D ( / ss AcDoc Space interval in n obj_vla l_coor last_p pt pt_vtx new_vtx prm indx flag nw_coor)
  (princ "\nSelecting an unfited 3Dpolyline")
  (cond
    ((setq ss (ssget '((0 . "POLYLINE") (-4 . "<AND") (-4 . "&") (70 . 8) (-4 . "<NOT") (-4 . "&") (70 . 4) (-4 . "NOT>") (-4 . "AND>"))))
      (initget 15)
      (setq
        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        Space
        (if (eq (getvar "CVPORT") 1)
          (vla-get-PaperSpace AcDoc)
          (vla-get-ModelSpace AcDoc)
        )
        interval (getdist "\nSpecify interval: ")
        in interval
      )
      (repeat (setq n (sslength ss))
        (setq
          obj_vla (vlax-ename->vla-object (ssname ss (setq n (1- n))))
          l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T)
          last_p (last l_coor)
        )
        (while (setq pt (vlax-curve-getPointAtDist obj_vla interval))
          (setq
            pt_vtx (vlax-curve-getClosestPointToProjection obj_vla (trans pt 1 0) '(0 0 1) nil)
            new_vtx (vlax-3d-point last_p)
            prm (vlax-curve-getParamAtPoint obj_vla pt_vtx)
            indx -1
          )
          (vla-AppendVertex obj_vla new_vtx)
          (repeat (if (vlax-curve-isClosed obj_vla) (fix (vlax-curve-getEndParam obj_vla)) (1+ (fix (vlax-curve-getEndParam obj_vla))))
            (setq indx (1+ indx))
            (if (or (not (eq indx (1+ (fix prm)))) flag)
              (setq nw_coor (cons (vlax-curve-getPointAtParam obj_vla indx) nw_coor))
              (setq nw_coor (cons pt_vtx nw_coor) indx (1- indx) flag T)
            )
          )
          (setq indx -1)
          (foreach e (reverse nw_coor)
            (vlax-put-property obj_vla 'Coordinate (setq indx (1+ indx)) (vlax-3d-point e))
          )
          (setq
            l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T)
            last_p (last l_coor)
            nw_coor nil
            flag nil
            interval (+ interval in)
          )
        )
        (setq interval in)
      )
    )
    (T (princ "\nNothing selected"))
  )
  (prin1)
)

 

[pyou]

17 hours ago, Tsuky said:

Hi,

Try this for 3dPolyline

(defun l-coor2l-pt (obj lst flag / )
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (if flag
          (+ (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0) (caddr lst))
          (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0)
        )
      )
      (l-coor2l-pt obj (if flag (cdddr lst) (cddr lst)) flag)
    )
  )
)
(defun c:add_vertex-3D ( / ss AcDoc Space interval in n obj_vla l_coor last_p pt pt_vtx new_vtx prm indx flag nw_coor)
  (princ "\nSelecting an unfited 3Dpolyline")
  (cond
    ((setq ss (ssget '((0 . "POLYLINE") (-4 . "<AND") (-4 . "&") (70 . 8) (-4 . "<NOT") (-4 . "&") (70 . 4) (-4 . "NOT>") (-4 . "AND>"))))
      (initget 15)
      (setq
        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        Space
        (if (eq (getvar "CVPORT") 1)
          (vla-get-PaperSpace AcDoc)
          (vla-get-ModelSpace AcDoc)
        )
        interval (getdist "\nSpecify interval: ")
        in interval
      )
      (repeat (setq n (sslength ss))
        (setq
          obj_vla (vlax-ename->vla-object (ssname ss (setq n (1- n))))
          l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T)
          last_p (last l_coor)
        )
        (while (setq pt (vlax-curve-getPointAtDist obj_vla interval))
          (setq
            pt_vtx (vlax-curve-getClosestPointToProjection obj_vla (trans pt 1 0) '(0 0 1) nil)
            new_vtx (vlax-3d-point last_p)
            prm (vlax-curve-getParamAtPoint obj_vla pt_vtx)
            indx -1
          )
          (vla-AppendVertex obj_vla new_vtx)
          (repeat (if (vlax-curve-isClosed obj_vla) (fix (vlax-curve-getEndParam obj_vla)) (1+ (fix (vlax-curve-getEndParam obj_vla))))
            (setq indx (1+ indx))
            (if (or (not (eq indx (1+ (fix prm)))) flag)
              (setq nw_coor (cons (vlax-curve-getPointAtParam obj_vla indx) nw_coor))
              (setq nw_coor (cons pt_vtx nw_coor) indx (1- indx) flag T)
            )
          )
          (setq indx -1)
          (foreach e (reverse nw_coor)
            (vlax-put-property obj_vla 'Coordinate (setq indx (1+ indx)) (vlax-3d-point e))
          )
          (setq
            l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T)
            last_p (last l_coor)
            nw_coor nil
            flag nil
            interval (+ interval in)
          )
        )
        (setq interval in)
      )
    )
    (T (princ "\nNothing selected"))
  )
  (prin1)
)

 

 

 

Thank you Tsuky, its perfect!

 

[pyou]

Would it be possible to modify this lisp to specify interval and gaps if required?

For example desired intervals are at 1m and gaps are 0.5m.  Gaps to be removed if required and only 3d polyline segments left.

 

Thank you

 

Example drawing attached

 

test.dwg

Edited May 4 by pyou

[Tsuky]

I did this, but tested superficially. I hope it does what you want!

Cut_Poly3D.lsp