Author Topic: HOw to join 3d polylines  (Read 10541 times)

0 Members and 1 Guest are viewing this topic.

matrix2005in

  • Guest
HOw to join 3d polylines
« on: June 01, 2006, 10:26:25 AM »
Hi there
i am looking for a lisp for :roll:

1) join multiple 3dpolylines
2) offset 3dpolylines

thanks


CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: HOw to join 3d polylines
« Reply #1 on: June 01, 2006, 10:51:06 AM »
3D Offset
http://www.theswamp.org/index.php?topic=1425.msg17839#msg17839

This one was one of my first lisp routines so don't look too closely at it.:)
Code: [Select]
;; Routine to convert 3d lines to as few as possable 3d polylines
;;  CAB 12/23/03
;;
;;   Collect all lines into a selection set
;;   Create a list of end points
;;   Walk through end points and find matches
;;   Create a list of points then make into plines
;;
(defun c:3dp (/ sslines lc ssl lep en end end1 end2 ptr 3dll pt)

  (if (setq sslines (ssget "X" '((0 . "LINE"))))
    (prompt "\nWorking, Please Wait.")
    (progn
      (prompt "\nNo Lines Found.    ")
      (exit)
    )
  )
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))
  (setvar "osmode" 0)
  (setq lc    0
ssl   (sslength sslines)
lep   (list)
3dcnt 0 ; # of 3d lines
fuzz  0 ; change as needed
  )
  (prompt (strcat "\n" (rtos (/ ssl 2) 2 0) " lines found."))
  (command "undo" "begin")
  (while (< lc ssl) ; make a list of line end points
    (setq en  (entget (ssname sslines lc))
  lep (cons (cdr (assoc 11 en)) lep)
  lep (cons (cdr (assoc 10 en)) lep)
  lc  (1+ lc)
    ) ; inc pointer
  ) ; end while

  (while lep
    ;; lep is a collection of line end points
    (setq end1 (car lep) ; get one end
  end2 (cadr lep) ; get the other end
  lep  (cddr lep) ; remove that line from list
  3dll (list)
  3dll (cons end2 3dll)
  3dll (cons end1 3dll); 3dll is the first segment of 3d poly line
  ptr  0 ; pointer
    )
    ;; 
    (while (<= (1+ ptr) (length lep))
      (setq end (nth ptr lep)) ; get a line end point from list
      (cond
((equal end end1 fuzz) ; found a matching point
(if (/= (/ ptr 2.0) (fix (/ ptr 2.0))) ; end of line
   ;; get pevious point
   (setq 3dll (cons (nth (1- ptr) lep) 3dll); add to begining of 3dll
end1 (car 3dll)
lep  (remove_pt (1- ptr) ptr)
   ) ; remove the end points from the list
   ;; else begining of line
   ;; get next point
   (setq 3dll (cons (nth (1+ ptr) lep) 3dll)
end1 (car 3dll)
lep  (remove_pt ptr (1+ ptr))
   ) ; remove the end points from the list
) ; endif
(setq ptr 0) ; reset pointer
) ; end cond 1

((equal end end2 fuzz)
(if (/= (/ ptr 2.0) (fix (/ ptr 2.0))) ; end of line
   ;; get pevious point
   (setq 3dll (append 3dll (list (nth (1- ptr) lep))); add to end of 3dll
end2 (nth (1- ptr) lep)
lep  (remove_pt (1- ptr) ptr)
   )
   ;; else begining of line
   ;; get next point
   (setq 3dll (append 3dll (list (nth (1+ ptr) lep)))
end2 (nth (1+ ptr) lep)
lep  (remove_pt ptr (1+ ptr))
   )
) ; endif
(setq ptr 0) ; reset pointer
) ; end cond 2
(t
(setq ptr (1+ ptr)) ; inc pointer
)
      ) ; end cond stmt
    ) ; end while
;;;=====================================================
;;;  Draw 3d poly here using points collected in 3dll
;;;=====================================================
    (if 3dll
      (progn
(command "3dpoly")
(foreach pt 3dll
  (command pt)
)
(command "")
(setq 3dcnt (1+ 3dcnt))
      )
    ); endif
  ) ; end while
  (command "_erase" sslines "")
  (command "undo" "end")
  (prompt (strcat "\n" (rtos 3dcnt 2 0) " 3dPoly lines created."))
  (prompt "\nProcess complete.\n")
  (setvar "osmode" useros)
  (setvar "CMDECHO" usercmd)
) ; end defun main

(defun remove_pt (first sec / cnt llen newlist)
  (setq cnt 0
llen (length lep)
newlist (list)
  )
  (while (< cnt llen)
    (if (and (/= cnt first) (/= cnt sec))
      (setq newlist (cons (nth cnt lep) newlist))
    )
    (setq cnt (1+ cnt))
  ); end while
  (reverse newlist)
); end defun
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

matrix2005in

  • Guest
Re: HOw to join 3d polylines
« Reply #2 on: June 01, 2006, 11:07:21 AM »
HI CAB
 :-(

3dp is converting lines to 3dpoly
offset3d is do not offset 3dpoly...it will work with polyline,line etc..and offset to z elevaton..
actually i am looking for
1) join multipple 3DPOLYLINE (like lwpolyline joining using pedit)
2) offset 3DPOLYLINE

thanks

Didge

  • Bull Frog
  • Posts: 211
Re: HOw to join 3d polylines
« Reply #3 on: June 01, 2006, 11:22:42 AM »
How about exploding your existing 3D polys into lines then use CAB's function.  Problem solved  :?
Think Slow......

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: HOw to join 3d polylines
« Reply #4 on: June 01, 2006, 11:33:19 AM »
Here is my "offset3dpoly":
Code: [Select]
;;Routine to offset 3Dpolylines
;;Jeff Mishler, April 2005
(defun c:offset3d (/ coords doc idx newcoords newpoly obj offdist offs space ss tmp tmpcoords)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
space (if (= (getvar "cvport") 1)
(vla-get-paperspace doc)
(vla-get-modelspace doc)
)
offdist (getdist "\nOffset distance, (negative to left, positive to right): ")
)
  (while (setq ss (ssget ":S" '((0 . "POLYLINE")(-4 . "&=")(70 . 8))))
    (setq obj (vlax-ename->vla-object (ssname ss 0))
  coords (vlax-get obj 'coordinates)
  )
    (setq tmp (vlax-invoke space 'addpolyline coords)
  offs (vlax-invoke tmp 'offset offdist)
  )
    (setq tmpcoords (vlax-get (car offs) 'coordinates)
  idx 0
  newcoords nil)
    (if (= (length coords) (length tmpcoords))
      (progn
(repeat (length coords)
  (if (= (rem idx 3) 2)
    (setq newcoords (append newcoords (list (nth idx coords))))
    (setq newcoords (append newcoords (list (nth idx tmpcoords))))
    )
  (setq idx (1+ idx))
  )
(setq newpoly (vlax-invoke space 'add3dpoly newcoords))
(vla-put-layer newpoly (vla-get-layer obj))
(vla-put-color newpoly (vla-get-color obj))
(vla-put-linetype newpoly (vla-get-linetype obj))
)
      (princ "\n....Unable to offset that 3dPoly.")
      )
    (vla-delete tmp)
    (vla-delete (car offs))
    )
  (princ)
  )

matrix2005in

  • Guest
Re: HOw to join 3d polylines
« Reply #5 on: June 01, 2006, 11:47:36 AM »
excellent jeff thats very nice.....

thanks man

what about 3d poly join?? :-)

matrix2005in

  • Guest
Re: HOw to join 3d polylines
« Reply #6 on: June 01, 2006, 02:24:39 PM »
Hello

anyone please?? :cry: :cry:

T.Willey

  • Needs a day job
  • Posts: 5251
Re: HOw to join 3d polylines
« Reply #7 on: June 01, 2006, 02:39:26 PM »
How about you start it, and then post back when you are stuck or you have finished the routine.  When/If you are stuck, people will help you past that part.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

matrix2005in

  • Guest
Re: HOw to join 3d polylines
« Reply #8 on: June 01, 2006, 02:49:37 PM »
hi

3dpoly offset is working fine..........actually there was two question..one is offset and other is joining..thats y i asked again...if some one can help me for joining 3dpolyline also..

thanks all

LE

  • Guest
Re: HOw to join 3d polylines
« Reply #9 on: June 01, 2006, 02:49:59 PM »
Hello

anyone please?? :cry: :cry:

Do you really want to learn how to write code, by following all the advise from all the talented programmers that frequent the swamp?

Please, read this url link:

http://www.theswamp.org/index.php?topic=2621.0
« Last Edit: June 01, 2006, 03:15:16 PM by Luis Esquivel »

Andrea

  • Water Moccasin
  • Posts: 2372
Re: HOw to join 3d polylines
« Reply #10 on: June 01, 2006, 04:18:54 PM »
Just adding some _ (underscore)...

Code: [Select]
;; Routine to convert 3d lines to as few as possable 3d polylines
;;  CAB 12/23/03
;;
;;   Collect all lines into a selection set
;;   Create a list of end points
;;   Walk through end points and find matches
;;   Create a list of points then make into plines
;;   Modified by AndreaLISP for Language version compatibilitie June 1 2006
(defun c:3dp (/ sslines lc ssl lep en end end1 end2 ptr 3dll pt)

  (if (setq sslines (ssget "X" '((0 . "LINE"))))
    (prompt "\nWorking, Please Wait.")
    (progn
      (prompt "\nNo Lines Found.    ")
      (exit)
    )
  )
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))
  (setvar "osmode" 0)
  (setq lc    0
ssl   (sslength sslines)
lep   (list)
3dcnt 0 ; # of 3d lines
fuzz  0 ; change as needed
  )
  (prompt (strcat "\n" (rtos (/ ssl 2) 2 0) " lines found."))
  (command "_undo" "_begin")
  (while (< lc ssl) ; make a list of line end points
    (setq en  (entget (ssname sslines lc))
  lep (cons (cdr (assoc 11 en)) lep)
  lep (cons (cdr (assoc 10 en)) lep)
  lc  (1+ lc)
    ) ; inc pointer
  ) ; end while

  (while lep
    ;; lep is a collection of line end points
    (setq end1 (car lep) ; get one end
  end2 (cadr lep) ; get the other end
  lep  (cddr lep) ; remove that line from list
  3dll (list)
  3dll (cons end2 3dll)
  3dll (cons end1 3dll); 3dll is the first segment of 3d poly line
  ptr  0 ; pointer
    )
    ;; 
    (while (<= (1+ ptr) (length lep))
      (setq end (nth ptr lep)) ; get a line end point from list
      (cond
((equal end end1 fuzz) ; found a matching point
(if (/= (/ ptr 2.0) (fix (/ ptr 2.0))) ; end of line
   ;; get pevious point
   (setq 3dll (cons (nth (1- ptr) lep) 3dll); add to begining of 3dll
end1 (car 3dll)
lep  (remove_pt (1- ptr) ptr)
   ) ; remove the end points from the list
   ;; else begining of line
   ;; get next point
   (setq 3dll (cons (nth (1+ ptr) lep) 3dll)
end1 (car 3dll)
lep  (remove_pt ptr (1+ ptr))
   ) ; remove the end points from the list
) ; endif
(setq ptr 0) ; reset pointer
) ; end cond 1

((equal end end2 fuzz)
(if (/= (/ ptr 2.0) (fix (/ ptr 2.0))) ; end of line
   ;; get pevious point
   (setq 3dll (append 3dll (list (nth (1- ptr) lep))); add to end of 3dll
end2 (nth (1- ptr) lep)
lep  (remove_pt (1- ptr) ptr)
   )
   ;; else begining of line
   ;; get next point
   (setq 3dll (append 3dll (list (nth (1+ ptr) lep)))
end2 (nth (1+ ptr) lep)
lep  (remove_pt ptr (1+ ptr))
   )
) ; endif
(setq ptr 0) ; reset pointer
) ; end cond 2
(t
(setq ptr (1+ ptr)) ; inc pointer
)
      ) ; end cond stmt
    ) ; end while
;;;=====================================================
;;;  Draw 3d poly here using points collected in 3dll
;;;=====================================================
    (if 3dll
      (progn
(command "_3dpoly")
(foreach pt 3dll
  (command pt)
)
(command "")
(setq 3dcnt (1+ 3dcnt))
      )
    ); endif
  ) ; end while
  (command "_erase" sslines "")
  (command "_undo" "_end")
  (prompt (strcat "\n" (rtos 3dcnt 2 0) " 3dPoly lines created."))
  (prompt "\nProcess complete.\n")
  (setvar "osmode" useros)
  (setvar "CMDECHO" usercmd)
) ; end defun main

(defun remove_pt (first sec / cnt llen newlist)
  (setq cnt 0
llen (length lep)
newlist (list)
  )
  (while (< cnt llen)
    (if (and (/= cnt first) (/= cnt sec))
      (setq newlist (cons (nth cnt lep) newlist))
    )
    (setq cnt (1+ cnt))
  ); end while
  (reverse newlist)
); end defun
Keep smile...

Serge J. Gianolla

  • Guest
Re: HOw to join 3d polylines
« Reply #11 on: June 01, 2006, 07:25:26 PM »
Have a look on the Autodesk Customising ng; same request by Mathew2006 posted02/06, reply by Gile

Quote
Hi,

Here is one, only prompts have been translated, comments are still in french.

Even lines, lwpolylines, 2Dpolylines and 3Dpolylines can be joined into a 3Dpolyline. The created 3Dpolyline gets the properties (layer, color, linetype ...) of the first selected object, arcs of lwpolylines aren't conserved.

Not tested!

LE

  • Guest
Re: HOw to join 3d polylines
« Reply #12 on: June 01, 2006, 07:28:44 PM »
Is the same person asking the same.

Serge J. Gianolla

  • Guest
Re: HOw to join 3d polylines
« Reply #13 on: June 01, 2006, 07:42:02 PM »
Is the same person asking the same.
Are you saying that Mathew2006 is Matrix2005in? :-o
Multiple personalities  :lol:
« Last Edit: June 01, 2006, 07:57:02 PM by Serge J. Gianolla »

matrix2005in

  • Guest
Re: HOw to join 3d polylines
« Reply #14 on: June 01, 2006, 10:16:40 PM »
who is thatttttttt?????????
 :x
:police: