Jump to content

ARRAY-VERTICES on 3D Polyline


pyou

Recommended Posts

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

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

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

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

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.

×
×
  • Create New...