3DPOLY

; 3D Utility             3Pedit.LSP          Ver 1.3           E Batson
; Convert 2d polyline, 3dface, line, arc, & circle to 3d polyline
; 1. Join 3Dpoly's (ends should meet).
; 2. If you accidently pick a 3DPoly, it is just drawn over again.
; 3. The Join function will replace the two 3DPolys with a single 3dPoly.
; 4. The Change function will just draw over the existing entity.
; 5. For a mesh , first explode it into faces, then change to 3dpoly(s).
; 6. Resolution will control smoothnes of curves, also make various shapes
;    such as... 6 = hex,  3 = triangle,  4 = square,  etc....
;*****************************************************************************
(princ "\nLoading...")
;..............................................................................
; Join two 3dpoly lines
(defun join3d
 (/ en flag1 flag2 en1 list1 list2 p1a p1b p2a p2b)
 (princ "\nJoin two 3DPolys.")
 (setq ss1 (entsel "\nSelect first 3dPoly.."))
 (redraw (car ss1) 3)
 (setq ss2 (entsel "....select second 3dPoly.."))
 (redraw (car ss2) 3)
 (setvar "blipmode" 0)
 (setq en1 (car ss1)
     poly1 (entget en1)
     flag1 (cdr(assoc 70 poly1))
       en2 (car ss2)
     poly2 (entget en2)
     flag2 (cdr(assoc 70 poly2))
 )
 (if (and (= (logand flag1 8) 8)(= (logand flag2 8) 8))  ; both 3D Polys ?
  (progn
    (setq lyr    (cdr(assoc 8 (entget en1)))             ; get first 3dpoly
          en     (entnext en1)                           ; stuff.
          list1 (cdr(assoc 10 (entget en)))
          chk1   (cdr(assoc 10 (entget en)))
          p1a    list1
    )
    (setq list1 (list list1))
    (while (= (cdr(assoc 0(entget(setq en(entnext en)))))"VERTEX")
       (setq list1 (append list1 (list(cdr(assoc 10(entget en))))))
       (setq p1b (cdr(assoc 10(entget en))))
    )
    (setq en     (entnext en2)                           ; get second 3dpoly
          list2 (cdr(assoc 10 (entget en)))              ; stuff.
          p2a list2
          chk2   (cdr(assoc 10 (entget en)))
    )
    (setq list2 (list list2))
    (while (= (cdr(assoc 0(entget(setq en(entnext en)))))"VERTEX")
      (setq list2 (append list2 (list(cdr(assoc 10(entget en))))))
      (setq p2b (cdr(assoc 10(entget en))))
    )
;-check for alignment of endpoints
    (cond
     ((equal p1b p2b 0.0001)                    ;if ---1----> 
      (setq list1 (reverse list1)))             ; reverse #1.
     ((equal p1a p2b 0.0001)                    ;if ----2---> ---1---->
        (setq tmp list1 list1 list2 list2 tmp)) ; swap them.
    );end cond
    ;---------- do the ends meet ? ---------------------------
    (if (or                                     ; Check to see if the two
         (equal p1a p2a 0.0001)                 ; 3Dpolys meet.
         (equal p1b p2b 0.0001)
         (equal p1a p2b 0.0001)
         (equal p1b p2a 0.0001)
         )
     (progn                                      ; ok, they meet.
   ;-erase old stuff
       (entdel en1);: ")))
 (if(boundp 'res)(setq #res res))
 (setq cnt -1)
 (setq ss (ssget))                                      ; get the stuff
 (princ "\nChanging..")
 (setq ssl (sslength ss))
 (repeat ssl                                            ; do 'em all.
  (setq e (ssname ss (setq cnt (1+ cnt))))
  (cond
   ((= (name e) "POLYLINE")(poly e))                    ; choices
   ((= (name e) "CIRCLE")(cir e))
   ((= (name e) "LINE")(lin e))
   ((= (name e) "ARC")                                  ; If its an ARC,
     (progn(command "pedit" e "y" "")(poly (entlast)))) ; change to polyline.
   ((= (name e) "3DFACE")(3df e))
  )
 )
)
;..........Main function....................
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Global variable = #res  (curve resolution)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:3pedit (/ choice)
 (initget "C J")
 (setq choice (getkword "\nChange/Join : "))
 (cond
  ((= choice "C")
    (change_to_3d))
  (T
    (join3d))
 )
 (setvar "blipmode" 0)
 (command "ucs" "w")
 (princ)
);end c:3pedit
(princ "\n3Pedit.LSP    - Ver 1.3 -     Compliments of Batson Tool Corp.")
(princ "\nUsage -> Command: 3Pedit ")
(prin1)

;;------------------=={ Join 3D Polylines }==-----------------;;
;;                                                            ;;
;;  Constructs a 3D Polyline spanning all polylines with      ;;
;;  coincident endpoints in a selection.                      ;;
;;  Note: properties of 3D Polylines are not retained.        ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
 
(defun c:3dpj ( / assocf grouppoints ent enx inc lst sel sub )
 
    (defun assocf ( x l f )
        (vl-some '(lambda ( a ) (if (equal x (car a) f) a)) l)
    )
 
    (defun grouppoints ( l / a r x x1 x2 )
        (while (setq x (car l))
            (setq l (cdr l))
            (while
                (cond
                    (   (setq a (assocf (setq x1 (car x)) l 1e-8))
                        (setq x (append (reverse a) (cdr x))
                              l (vl-remove a l)
                        )
                    )
                    (   (setq a (assocf (setq x2 (last x)) l 1e-8))
                        (setq x (append x (cdr a))
                              l (vl-remove a l)
                        )
                    )
                    (   (setq a (assocf x1 (setq l (mapcar 'reverse l)) 1e-8))
                        (setq x (append (reverse a) (cdr x))
                              l (vl-remove a l)
                        )
                    )
                    (   (setq a (assocf x2 l 1e-8))
                        (setq x (append x (cdr a))
                              l (vl-remove a l)
                        )
                    )
                )
            )
            (setq r (cons x r))
        )
    )
    
    (if (setq sel
            (ssget "_:L"
               '(   (0 . "POLYLINE")
                    (-4 . "
                        (-4 . "&=")
                        (70 . 8)
                        (-4 . "
                            (-4 . "&")
                            (70 . 7)
                        (-4 . "NOT>")
                    (-4 . "AND>")
                )
            )
        )
        (progn
            (repeat (setq inc (sslength sel))
                (setq ent (entnext (ssname sel (setq inc (1- inc))))
                      enx (entget ent)
                )
                (while (= "VERTEX" (cdr (assoc 0 enx)))
                    (setq sub (cons (cdr (assoc 10 enx)) sub)
                          ent (entnext ent)
                          enx (entget  ent)
                    )
                )
                (setq lst (cons (reverse sub) lst)
                      sub nil
                )
                (entdel (cdr (assoc -2 enx)))
            )
            (foreach lst (grouppoints lst)
                (entmake'((0 . "POLYLINE") (70 . 8)))
                (foreach pt lst
                    (entmake (list '(0 . "VERTEX") '(70 . 32) (cons 10 pt)))
                )
                (entmake '((0 . "SEQEND")))
            )
        )
    )
    (princ)
)