;=======================================================================
;    MakPface.Lsp                               Sep 19, 1998
;    Make A PFace Mesh From A Selection of 3DFaces
;================== Start Program ======================================
(princ "\nCopyright (C) 1998, Fabricated Designs, Inc.")
(princ "\nLoading MakPface v1.4 ")
(setq mpf_ nil lsp_file "MakPface")

;================== For Automated Calling From Another Program =========
(defun mpf_auto (ar1) (fa2pf ar1)) ;;;Supply PickSet Of Faces

;================== Macros =============================================
(defun PDot ()(princ "."))

(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun mpf_smd ()
 (SetUndo)
 (setq olderr *error*
      *error* (lambda (e)
                (and (/= e "quit / exit abort")
                     (princ (strcat "\nError: *** " e " *** ")))
                (command "_.UNDO" "_END" "_.U")
                (mpf_rmd))
       mpf_var '(("CMDECHO"   . 0) ("MENUECHO"   . 0)
                 ("MENUCTL"   . 0) ("MACROTRACE" . 0)
                 ("OSMODE"    . 0) ("SORTENTS"   . 119)
                 ("BLIPMODE"  . 0) ("MODEMACRO"  . ".")
                 ("SNAPMODE"  . 1) ("PLINEWID"   . 0.0)
                 ("ORTHOMODE" . 1) ("GRIDMODE"   . 0)
                 ("ELEVATION" . 0) ("THICKNESS"  . 0)
                 ("FILLMODE"  . 0) ("SPLFRAME"   . 0)
                 ("UCSICON"   . 1) ("HIGHLIGHT"  . 1)
                 ("REGENMODE" . 1) ("COORDS"     . 2)
                 ("CECOLOR"   . "BYLAYER") ("CELTYPE" . "BYLAYER")))
 (foreach v mpf_var
      (setq m_v (cons (getvar (car v)) m_v)
            m_n (cons (car v) m_n))
      (setvar (car v) (cdr v)))
 (princ (strcat (getvar "PLATFORM") " Release " (substr (ver) 18 2)
   " -  Make PFface Mesh ....\n"))
 (princ))

(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun mpf_rmd ()
  (setq *error* olderr)
  (mapcar 'setvar m_n m_v)
  (command "_.UNDO" "_END")
  (prin1))

(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
 (and (zerop (getvar "UNDOCTL"))
      (command "_.UNDO" "_ALL"))
 (and (= (logand (getvar "UNDOCTL") 2) 2)
      (command "_.UNDO" "_CONTROL" "_ALL"))
 (and (= (logand (getvar "UNDOCTL") 8) 8)
      (command "_.UNDO" "_END"))
 (command "_.UNDO" "_GROUP"))

(PDot);====== Convert A Selection Set Of 3DFaces To A PFace Mesh =======
  (defun fa2pf (ss / slen i ed en ef vlist vlen tlist)
  (and (/= (type ss) 'PICKSET)
       (princ "** Invalid Parameter To FA2PF ** ")
       (exit))
  (princ "\nDetermining Vertex Data\n")
  (setq slen (fix (sslength ss))
           i (1- slen))
  (while (>= i 0)
      (setq en (ssname ss i)
            ed (entget en)
             i (1- i))
       (and (/= (cdr (assoc 0 ed)) "3DFACE")
            (princ "\n** 3DFACES Only ** ")
            (exit))
       (foreach g '(10 11 12 13)
              (if (not (member (cdr (assoc g ed)) vlist))
                  (setq vlist (cons (cdr (assoc g ed)) vlist))))
       (princ (strcat "\r" (rtos (/ (* 100 i) slen) 2 0) "% ")))
  (princ "\nDetermining Face Data\n")
  (setq vlen (length vlist))
  (entmake (list (cons 0 "POLYLINE")
                 (cons 10 (list 0 0 0))
                 (cons 66 1)
                 (cons 70 64)
                 (cons 71 vlen)
                 (cons 72 slen)))
  (foreach v vlist
     (entmake (list (cons 0 "VERTEX")
                    (cons 10 v)
                    (cons 70 192))))
  (setq i (1- slen))
  (while (>= i 0)
    (setq en (ssname ss i)
          ed (entget en)
          ef (cdr (assoc 70 ed))
           i (1- i)
       tlist nil)
    (foreach c '(1 2 3 4)
      (setq tlist (cons
        (cons (+ 70 c)
              (* (if (= (logand ef (expt 2 (1- c))) (expt 2 (1- c))) -1 1)
                 (1+ (- vlen (length (member (cdr (assoc (+ 9 c) ed)) vlist))))))
            tlist)))
    (entmake (list (cons 0 "VERTEX")
                   (assoc 8 ed)
                   (cons 10 (last vlist))
                   (if (assoc 62 ed)
                       (assoc 62 ed)
                       (cons 62 256))
                   (cons 70 128)
                   (nth 0 tlist)
                   (nth 1 tlist)
                   (nth 2 tlist)
                   (nth 3 tlist)))
     (princ (strcat "\r" (rtos (/ (* 100 i) slen) 2 0) "% ")))
  (entmake (list (cons 0 "SEQEND")))
  (command "_.ERASE" ss "")
  (redraw (entlast)))

(PDot);************ Main Program ***************************************
(defun mpf_ (/ m_v m_n olderr mpf_var ssface)
  (mpf_smd)
  (setq ssface (ssget '((0 . "3DFACE"))))
  (fa2pf ssface)
  (mpf_rmd))

(PDot);************ Load Program ***************************************
(defun C:MakPface () (mpf_))
(if mpf_ (princ "\nMakPface Loaded\n"))
(prin1)
;================== End Program ========================================
;Tested With R12_c3 DOS & R13_c4a Only
;Copyright (C) 1998, Fabricated Designs, Inc.
;"AS IS" Public Domain Software Donated By
;
;
;        Fabricated Designs, Inc.
;        32 Maury Avenue
;        Newport News, Virginia  23601-2132
;         Ph: (757) 595-5949
;        FAX: (757) 595-5787
;        CIS: 73544,2655
;   Internet: http://ourworld.compuserve.com/homepages/DavidBethel/
;