Author Topic: 3d polyline splitting  (Read 1323 times)

0 Members and 2 Guests are viewing this topic.

mariolino0099

  • Newt
  • Posts: 29
3d polyline splitting
« on: April 18, 2024, 09:13:29 AM »
Hi, I have a problem with this code, it divides only the first unit of each segment and not all segments with distance equal or less than the assigned value.
The code should subdivide each segment of the 3dpoly with a value such that each subdivision is less than or at most equal to the assigned value. So for each segment of the 3dpoly there is a different value with which to subdivide that specific segment.
Can anyone help me ?


Code: [Select]
(defun c:poly_add_vertex (/ *error*       c_doc  sv_lst sv_vals
  mdst ss cnt    vlst   ent    elst
  obj flg sp     ep     lcnt   dst
  tdst p
)

  (defun *error* (msg)
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
      (princ (strcat "\nAn Error : " msg " occurred."))
    )
    (princ)
  ) ;_end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
sv_lst (list 'cmdecho 'osmode)
sv_vals (mapcar 'getvar sv_lst)
  ) ;end_setq

  (mapcar 'setvar sv_lst '(0 0))

  (initget 7)
  (setq
    mdst (getreal "\nEnter Max Distance between Polyline Vertices : "
)
  )

  (setq ss (ssget ":L" '((0 . "*POLYLINE"))))
  (cond
    (ss
     (repeat (setq cnt (sslength ss))
       (setq elst (entget (setq ent (ssname ss (setq cnt (1- cnt))))))
       (cond ((or (= 2 (logand 2 (cdr (assoc 70 elst))))
  (= 4 (logand 4 (cdr (assoc 70 elst))))
      )
     )
     (t
      (setq vlst nil
    obj (vlax-ename->vla-object ent)
    flg (if (= (vlax-get obj 'objectname) "AcDbPolyline")
   T
   nil
)
    sp 0
    ep (vlax-curve-getendparam ent)
    vlst (cons (if flg
(reverse
   (cdr (reverse (vlax-curve-getstartpoint ent)))
)
(vlax-curve-getstartpoint ent)
       )
       vlst
)
    lcnt 0.0
      ) ;end_setq
      (while (< sp ep)
(setq dst  (distance (vlax-curve-getpointatparam ent sp)
     (vlax-curve-getpointatparam ent (1+ sp))
   )
      tdst dst
)
(cond ((> dst mdst)
       (while (> tdst mdst)
(setq vlst (cons
      (if flg
(reverse
  (cdr (reverse
(vlax-curve-getpointatdist
   ent
   (setq lcnt (+ lcnt (/ mdst dst)))
)
       )
  )
)
(vlax-curve-getpointatdist
  ent
  (setq lcnt (+ lcnt (/ mdst dst)))
)
      )
      vlst
    )
       tdst (- tdst mdst)
) ;end_setq
       ) ;end_while
      )
) ;end_cond
(setq sp   (1+ sp)
      vlst (cons
     (if flg
       (reverse
(cdr
   (reverse (vlax-curve-getpointatparam ent sp))
)
       )
       (vlax-curve-getpointatparam ent sp)
     )
     vlst
   )
      lcnt (vlax-curve-getdistatparam ent sp)
) ;end_setq
      ) ;end_while
      (cond (flg
     (setq sp 0)
     (while (< sp ep)
       (vlax-invoke obj 'setbulge sp 0.0)
       (setq sp (1+ sp))
     )
    )
      )
      (vlax-put obj 'coordinates (apply 'append (reverse vlst)))
     )
       ) ;end_cond
     ) ;end_repeat
    )
    (t (alert "Nothing Selected"))
  ) ;end_cond
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
) ;end_defun

;"AcDb2dPolyline" if curved

ribarm

  • Gator
  • Posts: 3307
  • Marko Ribar, architect
Re: 3d polyline splitting
« Reply #1 on: April 19, 2024, 08:16:59 AM »
Code - Auto/Visual Lisp: [Select]
  1. (defun c:splitpolylines ( / gap ss i poly segx d r )
  2.   (initget 6)
  3.   (setq gap (cond ( (getdist "\nPick or specify gap <0.0> : ") ) (0.0)))
  4.   (prompt "\nSelect polylines on unlocked layer(s)...")
  5.   (if (setq ss (ssget "_:L" (list (cons 0 "*POLYLINE"))))
  6.     (repeat (setq i (sslength ss))
  7.       (setq poly (ssname ss (setq i (1- i))))
  8.       (vl-catch-all-apply (if command-s (function command-s) (function vl-cmdf)) (list "_.explode" poly))
  9.       (foreach seg (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex (ssget "_p"))))
  10.         (cond
  11.           ( (= (cdr (assoc 0 (setq segx (entget seg)))) "LINE")
  12.             (setq segx (subst (cons 10 (mapcar (function +) (cdr (assoc 10 segx)) (mapcar (function *) (mapcar (function /) (mapcar (function -) (cdr (assoc 11 segx)) (cdr (assoc 10 segx))) (list (setq d (distance (cdr (assoc 10 segx)) (cdr (assoc 11 segx)))) d d)) (list gap gap gap)))) (assoc 10 segx) segx))
  13.             (setq segx (subst (cons 11 (mapcar (function +) (cdr (assoc 11 segx)) (mapcar (function *) (mapcar (function /) (mapcar (function -) (cdr (assoc 10 segx)) (cdr (assoc 11 segx))) (list d d d)) (list gap gap gap)))) (assoc 11 segx) segx))
  14.             (entupd (cdr (assoc -1 (entmod segx))))
  15.           )
  16.           ( t
  17.             (setq r (cdr (assoc 40 segx)))
  18.             (setq segx (subst (cons 50 (+ (cdr (assoc 50 segx)) (/ gap r))) (assoc 50 segx) segx))
  19.             (setq segx (subst (cons 51 (- (cdr (assoc 51 segx)) (/ gap r))) (assoc 51 segx) segx))
  20.             (entupd (cdr (assoc -1 (entmod segx))))
  21.           )
  22.         )
  23.       )
  24.     )
  25.   )
  26.   (princ)
  27. )
  28.  

HTH.
M.R.
« Last Edit: April 20, 2024, 08:55:10 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

mariolino0099

  • Newt
  • Posts: 29
Re: 3d polyline splitting
« Reply #2 on: April 22, 2024, 02:21:15 AM »
Marko many thanks,
the code should do the splitting as shown in the image. Basically introduced the user length (0.7 in the example), do the splitting of each individual segment of the 3dpoly and then round to the nearest integer and use a different splitting length for each segment
thanks

DEVITG

  • Bull Frog
  • Posts: 481
Re: 3d polyline splitting
« Reply #3 on: April 22, 2024, 03:29:13 PM »
@mariolino099

Please Upload your sample.dwg
Location @ Córdoba Argentina Using ACAD 2019  at Window 10

mariolino0099

  • Newt
  • Posts: 29
Re: 3d polyline splitting
« Reply #4 on: April 23, 2024, 02:27:03 AM »
thanks..

DEVITG

  • Bull Frog
  • Posts: 481
Re: 3d polyline splitting
« Reply #5 on: April 27, 2024, 08:01:50 AM »
@mariolino0099 , i will check .
Location @ Córdoba Argentina Using ACAD 2019  at Window 10

mariolino0099

  • Newt
  • Posts: 29
Re: 3d polyline splitting
« Reply #6 on: April 30, 2024, 11:32:23 AM »
Hi,
this is the result with my code, it correctly performs the subdivision calculation, but it only subdivides the first unit of length for each segment condensing all subdivisions there without making a uniform subdivision.
Thnaks

mariolino0099

  • Newt
  • Posts: 29
Re: 3d polyline splitting
« Reply #7 on: May 07, 2024, 05:56:33 AM »
Please can anyone help me ?
Thanks

ribarm

  • Gator
  • Posts: 3307
  • Marko Ribar, architect
Re: 3d polyline splitting
« Reply #8 on: May 08, 2024, 09:16:36 AM »
Try this code...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:split3dpolyssegs ( / *error* getvertices unit d cmd uf s in plx pl vl a b dd n sd nvl k )
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if uf
  6.       (if command-s
  7.         (command-s "_.UCS" "_P")
  8.         (vl-cmdf "_.UCS" "_P")
  9.       )
  10.     )
  11.     (while (= 8 (logand 8 (getvar (quote undoctl))))
  12.       (if command-s
  13.         (command-s "_.UNDO" "_E")
  14.         (vl-cmdf "_.UNDO" "_E")
  15.       )
  16.     )
  17.     (if cmd
  18.       (setvar (quote cmdecho) cmd)
  19.     )
  20.     (if m
  21.       (prompt m)
  22.     )
  23.     (princ)
  24.   )
  25.  
  26.   (defun getvertices ( c / i p plst )
  27.     (setq i -1)
  28.     (while (<= (setq i (1+ i)) (vlax-curve-getendparam c))
  29.       (setq p (vlax-curve-getpointatparam c i))
  30.       (setq plst (cons p plst))
  31.     )
  32.     (reverse plst)
  33.   )
  34.  
  35.   (defun unit ( v / d )
  36.     (if (not (equal (setq d (distance (list 0.0 0.0 0.0) v)) 0.0 1e-6))
  37.       (mapcar (function (lambda ( x ) (/ x d))) v)
  38.     )
  39.   )
  40.  
  41.   (setq d 0.7) ;;; initial setting - change to suit your needs ;;;
  42.  
  43.   (setq cmd (getvar (quote cmdecho)))
  44.   (setvar (quote cmdecho) 0)
  45.   (while (= 8 (logand 8 (getvar (quote undoctl))))
  46.     (if command-s
  47.       (command-s "_.UNDO" "_E")
  48.       (vl-cmdf "_.UNDO" "_E")
  49.     )
  50.   )
  51.   (if command-s
  52.     (command-s "_.UNDO" "_BE")
  53.     (vl-cmdf "_.UNDO" "_BE")
  54.   )
  55.   (if (= 0 (getvar (quote worlducs)))
  56.     (progn
  57.       (if command-s
  58.         (command-s "_.UCS" "_W")
  59.         (vl-cmdf "_.UCS" "_W")
  60.       )
  61.       (setq uf t)
  62.     )
  63.   )
  64.   (prompt "\nPick reference 3D polyline(s)...")
  65.   (if (setq s (ssget (list (cons 0 "POLYLINE") (cons -4 "<or") (cons 70 8) (cons 70 9) (cons -4 "or>"))))
  66.     (repeat (setq in (sslength s))
  67.       (setq plx (entget (setq pl (ssname s (setq in (1- in))))))
  68.       (setq vl (getvertices pl))
  69.       (while (setq b (cadr vl))
  70.         (setq dd (distance (setq a (car vl)) b))
  71.         (if (> (fix (/ dd d)) 0)
  72.           (setq n (fix (/ dd d)))
  73.           (setq n (fix (1+ (/ dd d))))
  74.         )
  75.         (setq sd (/ dd n))
  76.         (setq nvl (cons a nvl))
  77.         (setq k 0)
  78.         (repeat n
  79.           (setq nvl (cons (mapcar (function +) a (mapcar (function *) (unit (mapcar (function -) b a)) (list (* (setq k (1+ k)) sd) (* k sd) (* k sd)))) nvl))
  80.         )
  81.         (setq vl (cdr vl))
  82.       )
  83.       (setq a (car nvl))
  84.       (setq nvl (cdr nvl))
  85.       (if (not (vlax-curve-isclosed pl))
  86.         (setq nvl (cons a nvl))
  87.       )
  88.       (setq nvl (reverse nvl))
  89.       (vl-cmdf "_.3DPOLY")
  90.       (foreach v nvl
  91.         (vl-cmdf "_non" v)
  92.       )
  93.       (if (vlax-curve-isclosed pl)
  94.         (while (< 0 (getvar (quote cmdactive)))
  95.           (vl-cmdf "_C")
  96.         )
  97.         (while (< 0 (getvar (quote cmdactive)))
  98.           (vl-cmdf "")
  99.         )
  100.       )
  101.       (setq nvl nil)
  102.     )
  103.   )
  104.   (*error* nil)
  105. )
  106.  

Regards, M.R.
« Last Edit: May 10, 2024, 10:43:24 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3307
  • Marko Ribar, architect
Re: 3d polyline splitting
« Reply #9 on: May 08, 2024, 09:53:53 AM »
And this code is opposite of splitting by adding vertices... It's called "diet3dps" like my latest with lwpolyline that I coded recently...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:diet3dps ( / *error* unique getvertices collinear-p group_collinear_pts cmd uf s in pl plx cf vl nvl gg )
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (while (= 8 (logand 8 (getvar (quote undoctl))))
  6.       (if command-s
  7.         (command-s "_.UNDO" "_E")
  8.         (vl-cmdf "_.UNDO" "_E")
  9.       )
  10.     )
  11.     (if uf
  12.       (if command-s
  13.         (command-s "_.UCS" "_P")
  14.         (vl-cmdf "_.UCS" "_P")
  15.       )
  16.     )
  17.     (if cmd
  18.       (setvar (quote cmdecho) cmd)
  19.     )
  20.     (if m
  21.       (prompt m)
  22.     )
  23.     (princ)
  24.   )
  25.  
  26.   (defun unique ( lst )
  27.     (if lst
  28.       (cons (car lst)
  29.         (unique
  30.           (vl-remove-if (function (lambda ( x ) (equal x (car lst) 1e-6)))
  31.             (cdr lst)
  32.           )
  33.         )
  34.       )
  35.     )
  36.   )
  37.  
  38.   (defun getvertices ( c / i p ptlst )
  39.     (setq i -1)
  40.     (while (<= (setq i (1+ i)) (vlax-curve-getendparam c))
  41.       (setq p (vlax-curve-getpointatparam c i))
  42.       (setq ptlst (cons p ptlst))
  43.     )
  44.     (reverse ptlst)
  45.   )
  46.  
  47.   (defun collinear-p ( p1 p p2 )
  48.     (and
  49.       (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  50.       (equal (angle p1 p2) (angle p1 p) 1e-6)
  51.       (equal (angle p1 p2) (angle p p2) 1e-6)
  52.     )
  53.   )
  54.  
  55.   (defun group_collinear_pts ( ptlst / a b c g gg )
  56.     (while ptlst
  57.       (setq a (car ptlst) b (cadr ptlst) c (caddr ptlst))
  58.       (while (and c (collinear-p a b c))
  59.         (if (not (vl-position a g))
  60.           (setq g (cons a g))
  61.         )
  62.         (if (not (vl-position b g))
  63.           (setq g (cons b g))
  64.         )
  65.         (if (not (vl-position c g))
  66.           (setq g (cons c g))
  67.         )
  68.         (setq ptlst (cdr ptlst))
  69.         (setq a (car ptlst) b (cadr ptlst) c (caddr ptlst))
  70.       )
  71.       (setq ptlst (cdr ptlst))
  72.       (if g
  73.         (setq gg (cons (reverse g) gg))
  74.       )
  75.       (setq g nil)
  76.     )
  77.     (reverse gg)
  78.   )
  79.  
  80.   (setq cmd (getvar (quote cmdecho)))
  81.   (setvar (quote cmdecho) 0)
  82.   (while (= 8 (logand 8 (getvar (quote undoctl))))
  83.     (if command-s
  84.       (command-s "_.UNDO" "_E")
  85.       (vl-cmdf "_.UNDO" "_E")
  86.     )
  87.   )
  88.   (if command-s
  89.     (command-s "_.UNDO" "_BE")
  90.     (vl-cmdf "_.UNDO" "_BE")
  91.   )
  92.   (if (= 0 (getvar (quote worlducs)))
  93.     (progn
  94.       (if command-s
  95.         (command-s "_.UCS" "_W")
  96.         (vl-cmdf "_.UCS" "_W")
  97.       )
  98.       (setq uf t)
  99.     )
  100.   )
  101.   (prompt "\nPick reference 3D polyline(s)...")
  102.   (if (setq s (ssget (list (cons 0 "POLYLINE") (cons -4 "<or") (cons 70 8) (cons 70 9) (cons -4 "or>"))))
  103.     (repeat (setq in (sslength s))
  104.       (setq plx (entget (setq pl (ssname s (setq in (1- in))))))
  105.       (if (= 9 (cdr (assoc 70 plx)))
  106.         (setq cf t)
  107.       )
  108.       (setq vl (getvertices pl))
  109.       (setq nvl vl)
  110.       (setq gg (group_collinear_pts nvl))
  111.       (foreach g gg
  112.         (setq g (cdr g) g (reverse (cdr (reverse g))))
  113.         (foreach p g
  114.           (setq nvl (vl-remove-if (function (lambda ( x ) (equal p x 1e-6))) nvl))
  115.         )
  116.       )
  117.       (if cf
  118.         (setq nvl (reverse (cdr (reverse nvl))))
  119.       )
  120.       (setq nvl (unique nvl))
  121.       (vl-cmdf "_.3DPOLY")
  122.       (foreach v nvl
  123.         (vl-cmdf "_non" v)
  124.       )
  125.       (if cf
  126.         (while (< 0 (getvar (quote cmdactive)))
  127.           (vl-cmdf "_C")
  128.         )
  129.         (while (< 0 (getvar (quote cmdactive)))
  130.           (vl-cmdf "")
  131.         )
  132.       )
  133.       (setq nvl nil cf nil gg nil)
  134.     )
  135.   )
  136.   (*error* nil)
  137. )
  138.  

HTH.
M.R.
« Last Edit: May 10, 2024, 10:44:24 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

mariolino0099

  • Newt
  • Posts: 29
Re: 3d polyline splitting
« Reply #10 on: May 10, 2024, 02:37:53 AM »
hello ribarm
thanks for the help, i edited the line first
  (if (setq s (ssget "_.+:E:S" (list (cons 0 "POLYLINE") (cons -4 "<or") (cons 70 8) (cons 70 9) (cons -4 "or>"))))
because it was going to error.
For the four-vertex 3dpoly works, in the more complicated case (example_1.dwg) it seems to going inside a infinite loop...
Am I doing something wrong ?
Is possible to select multiple 3dpoly ?

Thnaks



Code: [Select]
    (defun c:split3dpolysegs ( / *error* getvertices unit d cmd uf s plx pl vl a b dd n sd nvl k )
     
      (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))
     
      (defun *error* ( m )
        (if uf
          (if command-s
            (command-s "_.UCS" "_P")
            (vl-cmdf "_.UCS" "_P")
          )
        )
        (if cmd
          (setvar (quote cmdecho) cmd)
        )
        (if m
          (prompt m)
        )
        (princ)
      )
     
      (defun getvertices ( c / i p plst )
        (setq i -1)
        (while (<= (setq i (1+ i)) (vlax-curve-getendparam c))
          (setq p (vlax-curve-getpointatparam c i))
          (setq plst (cons p plst))
        )
        (reverse plst)
      )
     
      (defun unit ( v / d )
        (if (not (equal (setq d (distance (list 0.0 0.0 0.0) v)) 0.0 1e-6))
          (mapcar (function (lambda ( x ) (/ x d))) v)
        )
      )
     
;      (setq d 1) ;;; initial setting - change to suit your needs ;;;
     
      (setq cmd (getvar (quote cmdecho)))
      (setvar (quote cmdecho) 0)
      (if (= 0 (getvar (quote worlducs)))
        (progn
          (if command-s
            (command-s "_.UCS" "_W")
            (vl-cmdf "_.UCS" "_W")
          )
          (setq uf t)
        )
      )
 
  (initget 7)
  (setq
d (getreal "\nEnter Max Distance between Polyline Vertices : "
)
  )
 
 
      (prompt "\nPick reference 3D polyline...")
      (if (setq s (ssget "_+.:E:S" (list (cons 0 "POLYLINE") (cons -4 "<or") (cons 70 8) (cons 70 9) (cons -4 "or>"))))
        (progn
          (setq plx (entget (setq pl (ssname s 0))))
          (setq vl (getvertices pl))
          (while (setq b (cadr vl))
            (if (< d (setq dd (distance (setq a (car vl)) b)))
              (progn
                (setq n (fix (/ dd d)))
                (setq sd (/ dd n))
                (setq nvl (cons a nvl))
                (setq k 0)
                (repeat n
                  (setq nvl (cons (mapcar (function +) a (mapcar (function *) (unit (mapcar (function -) b a)) (list (* (setq k (1+ k)) sd) (* k sd) (* k sd)))) nvl))
                )
                (setq vl (cdr vl))
              )
            )
          )
          (setq a (car nvl))
          (setq nvl (cdr nvl))
          (if (not (vlax-curve-isclosed pl))
            (setq nvl (cons a nvl))
          )
          (setq nvl (reverse nvl))
          (vl-cmdf "_.3DPOLY")
          (foreach v nvl
            (vl-cmdf "_non" v)
          )
          (if (vlax-curve-isclosed pl)
            (while (< 0 (getvar (quote cmdactive)))
              (vl-cmdf "_C")
            )
            (while (< 0 (getvar (quote cmdactive)))
              (vl-cmdf "")
            )
          )
        )
      )
      (*error* nil)
    )
     

ribarm

  • Gator
  • Posts: 3307
  • Marko Ribar, architect
Re: 3d polyline splitting
« Reply #11 on: May 10, 2024, 10:52:29 AM »
@mariolino0099
I've fixed (while) endless loop, but it doesn't follow exact math because segments lengths are less than 0.7 units, so if I divide it with 0.7 and (fix) that number I get 0 - which gives another error - divide by zero... So, I had to include one (if) statement that will ensure that your first *.DWG is processed correctly with verices numbers like you presented on right side 3d polyline, and your second *.DWG is processed with that second - else (if) statement (setq n (fix (1+ (/ dd d)))) ... That 1+ is to ensure that divide by zero doesn't occur...
So, test my codes now, as I think that better than this is not neccessary...
« Last Edit: May 10, 2024, 11:09:27 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

mariolino0099

  • Newt
  • Posts: 29
Re: 3d polyline splitting
« Reply #12 on: May 13, 2024, 12:16:02 PM »
Thanks Ribarm,

your code for split now works great !!!
I also tried the diet code that eliminates collinear points works very well.
One suggestion I would make different for this command would be the introduction of a length to be requested from the user at the beginning of the command, for collinear vertex distances smaller than the entered size such intermediate vertices are deleted in the case of larger distances the intermediate vertices remain.

 :-) :-) :-)