Jump to content

ARRAY-VERTICES on 3D Polyline

pyou

By pyou
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

pyou Enthusiast

pyou

Posted
Posted

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

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

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

Link to comment
Share on other sites
Tsuky Community Regular

Tsuky

Posted
Posted

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

 

  • Thanks 1
Link to comment
Share on other sites
pyou Enthusiast

pyou

Posted
  • Author
Posted
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!

 

Link to comment
Share on other sites
  • 2 months later...
pyou Enthusiast

pyou

Posted
  • Author
Posted (edited)

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 by pyou
Link to comment
Share on other sites
  • 3 weeks later...
pyou Enthusiast

pyou

Posted
  • Author
Posted
On 05/05/2024 at 23:52, Tsuky said:

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

Cut_Poly3D.lsp 4.82 kB · 4 downloads

Tsuky, I have noticed if I split polyline into equal  segment lengths for example 0.50m and 0.50m  its not working, but  if do 0.50m and 0.51m  it works, do you know what causing this and what modification would need? 

Link to comment
Share on other sites
Tsuky Community Regular

Tsuky

Posted
Posted

You're right, it's buggy in this specific case.
Your tip is good
If I want to apply your tip to the code I would add after line 46
(if (equal in in2 1E-08) (setq in2 (+ in2 1E-07)))
because I am doing a test from line 114 to 126 to 1E-08 on the inter-distance and if in = in2; it erases everything.
Which explains why only the last segment remains.
This modification may be enough because modifying my code would become more complicated. This would be another algorithm and it's worth my time... Is this only for a representation? 1E-07 is really little and is sufficient for a representation of discontinuity.

  • Like 1
Link to comment
Share on other sites
pyou Enthusiast

pyou

Posted
  • Author
Posted
4 hours ago, Tsuky said:

You're right, it's buggy in this specific case.
Your tip is good
If I want to apply your tip to the code I would add after line 46
(if (equal in in2 1E-08) (setq in2 (+ in2 1E-07)))
because I am doing a test from line 114 to 126 to 1E-08 on the inter-distance and if in = in2; it erases everything.
Which explains why only the last segment remains.
This modification may be enough because modifying my code would become more complicated. This would be another algorithm and it's worth my time... Is this only for a representation? 1E-07 is really little and is sufficient for a representation of discontinuity.

yes, your modification definitely fixed bug and works now. Thank you!

Link to comment
Share on other sites
  • 3 weeks later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...