;=======================================================================
; AR-Face.Lsp Mar 20, 2001
; Convert All Traces To 3DFaces (like outline)
; Little modified by Igal Averbuh 2016 (adapted for traces only)
;================== Start Program ======================================
(princ "\nCopyright (C) 2001, Fabricated Designs, Inc.")
(princ "\nLoading AR-Face v1.1 ")

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

;;Mid Point Of 2 Lines
(defun mid_pt (p1 p2 / xp yp zp)
(setq xp (+ (nth 0 p1) (* 0.5 (- (nth 0 p2) (nth 0 p1)))))
(setq yp (+ (nth 1 p1) (* 0.5 (- (nth 1 p2) (nth 1 p1)))))
(setq zp (+ (nth 2 p1) (* 0.5 (- (nth 2 p2) (nth 2 p1)))))
(list xp yp zp))

(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun arf_smd ()
(SetUndo)
(setq oldlay (getvar "CLAYER")
olderr *error*
*error* (lambda (e)
(and (/= e "quit / exit abort")
(/= e "Function cancelled")
(princ (strcat "\nError: *** " e " *** ")))
(command "_.UNDO" "_END" "_.U")
(arf_rmd))
arf_var '(
("CMDECHO" . 0) ("MENUECHO" . 0) ("MENUCTL" . 0) ("MACROTRACE" . 0)
("PDMODE" . 0) ("OSMODE" . 0) ("SORTENTS" . 119)("MODEMACRO" . ".")
("BLIPMODE" . 0) ("EXPERT" . 0) ("SNAPMODE" . 1) ("DIMZIN" . 0)
("ORTHOMODE" . 1) ("GRIDMODE" . 0) ("ELEVATION" . 0) ("THICKNESS" . 0)
("FILEDIA" . 0) ("FILLMODE" . 0) ("SPLFRAME" . 0) ("UCSICON" . 0)
("COORDS" . 2) ("DRAGMODE" . 2) ("HIGHLIGHT" . 1) ("REGENMODE" . 1)
("CECOLOR" . "BYLAYER") ("CELTYPE" . "BYLAYER")))
(foreach v arf_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 " (ver)
" - Accurender Face Conversions ....\n"))
(princ))

(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun arf_rmd ()
(SetLayer oldlay)
(command "_.UNDO" "_END")
(setq *error* olderr)
(mapcar 'setvar m_n m_v)
(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);++++++++++++ Make Layer Current +++++++++++++++++++++++++++++++++
(defun SetLayer (name / ldef flag)
(command "_.LAYER")
(if (not (tblsearch "LAYER" name))
(command "_Make" name)
(progn
(setq ldef (tblsearch "LAYER" name)
flag (cdr (assoc 70 ldef)))
(and (= (logand flag 1) 1)
(command "_Thaw" name))
(and (minusp (cdr (assoc 62 ldef)))
(command "_On" name))
(and (= (logand flag 4) 4)
(command "_Unlock" name))
(and (= (logand flag 16) 16)
(princ "\nCannot Set To XRef Dependent Layer")
(quit))
(command "_Set" name)))
(command "")
name)

(PDot);++++++++++++ Convert Solids & Traces To 3Dfaces +++++++++++++++++
(defun arf_sol (/ b10 b11 b12 b13 s20 s21 s22 s23)
(setq b10 (trans p10 en 0)
b11 (trans p11 en 0)
b12 (trans p12 en 0)
b13 (trans p13 en 0))
(entmake (list (cons 0 "3DFACE")
(cons 8 lay)
(cons 10 b10)
(cons 11 b11)
(cons 12 b13)
(cons 13 b12)
(cons 62 256)
(cons 70 0)))
(if (not (zerop thk))
(progn
(setq s20 (trans (list (car p10) (cadr p10) (+ (caddr p10) thk)) en 0)
s21 (trans (list (car p11) (cadr p11) (+ (caddr p11) thk)) en 0)
s22 (trans (list (car p12) (cadr p12) (+ (caddr p12) thk)) en 0)
s23 (trans (list (car p13) (cadr p13) (+ (caddr p13) thk)) en 0))
(entmake (list (cons 0 "3DFACE")
(cons 8 lay)
(cons 10 s20)
(cons 11 s21)
(cons 12 s23)
(cons 13 s22)
(cons 62 256)
(cons 70 0)))
(entmake (list (cons 0 "3DFACE")
(cons 8 lay)
(cons 10 b10)
(cons 11 b11)
(cons 12 s21)
(cons 13 s20)
(cons 62 256)
(cons 70 0)))
(entmake (list (cons 0 "3DFACE")
(cons 8 lay)
(cons 10 b11)
(cons 11 b13)
(cons 12 s23)
(cons 13 s21)
(cons 62 256)
(cons 70 0)))
(entmake (list (cons 0 "3DFACE")
(cons 8 lay)
(cons 10 b12)
(cons 11 b13)
(cons 12 s23)
(cons 13 s22)
(cons 62 256)
(cons 70 0)))
(entmake (list (cons 0 "3DFACE")
(cons 8 lay)
(cons 10 b10)
(cons 11 b12)
(cons 12 s22)
(cons 13 s20)
(cons 62 256)
(cons 70 0))))))

(PDot);++++++++++++ Convert Lines To 3DFaces +++++++++++++++++++++++++++
(defun arf_line (/ p20 p21)
(setq ExtTk (mapcar '(lambda (x) ;;ExtDir[X] * tk
(* x thk)) ;;ExtDir[Y] * tk
ecs)) ;;ExtDir[Z] * tk
(setq p20 (mapcar '+ ExtTk p10)
p21 (mapcar '+ ExtTk p11))
(entmake (list (cons 0 "3DFACE")
(cons 8 lay)
(cons 10 p10)
(cons 11 p20)
(cons 12 p21)
(cons 13 p11)
(cons 62 256)
(cons 70 0))))

(PDot);++++++++++++ Convert Circles To 3DFaces +++++++++++++++++++++++++
(defun arf_circle (/ cen rad c10 c11 c20 c21 ar1 ar2 ar3
cent c10t ar1t ar2t ar3t def)
(setq cen (cdr (assoc 10 ed))
rad (cdr (assoc 40 ed))
c10 (trans cen en 0)
c11 (polar c10 0.0 rad))

(setq def (cond ((<= rad 1) 6)
((<= rad 2) 8)
(( san ean)
(setq inc (- (+ (* pi 2.) ean) san))
(setq inc (- ean san)))

(setq def (cond ((<= rad 1) 6)
((<= rad 2) 8)
((<= rad 4) 10)
(T (fix (* rad 2)))))

(setq seg (1+ (fix (/ inc (/ pi def))))
sta (/ inc seg))
(if (not (equal ecs '(0 0 1) 0.00001))
(progn
(command "_.UCS" "_E" en)
(setq san 0.0
cen (trans (cdr (assoc 10 ed)) en 1)
spt (polar cen san rad)))
(progn
(command "_.UCS" "_World")
(setq spt (polar cen san rad))))
(setvar "THICKNESS" thk)
(setvar "CECOLOR" (itoa clr))
(repeat (1+ seg)
(setq npt (polar cen san rad))
(SetLayer lay)
(command "_.LINE" spt npt "")
(setq tempe (entlast))
(setq p10 (cdr (assoc 10 (entget (entlast)))))
(setq p11 (cdr (assoc 11 (entget (entlast)))))
(setq ecs (cdr (assoc 210 (entget (entlast)))))
(arf_line)
(entdel tempe)
(setq san (+ san sta)
spt npt))
(setvar "THICKNESS" 0.0)
(setvar "CECOLOR" "BYLAYER")
(command "_.UCS" "_World"))

(PDot);************ Main Program ***************************************
(defun arf_ (/ m_v m_n arf_var exttk olderr oldlay
en ed et lay clr thk flg ecs
p10 p11 p12 p13 ss i)

(arf_smd)

(princ "\nReading Data ...")
(setq ss (ssget "X" '((0 . "TRACE"))))
(princ "\nConverting Data....\n")
(setq i (sslength ss)
slen i)
(while (not (minusp (setq i (1- i))))
(setq en (ssname ss (fix i))
ed (entget en)
et (cdr (assoc 0 ed))
lay (cdr (assoc 8 ed))
p10 (cdr (assoc 10 ed))
p11 (cdr (assoc 11 ed))
p12 (cdr (assoc 12 ed))
p13 (cdr (assoc 13 ed))
thk (cdr (assoc 39 ed))
clr (cdr (assoc 62 ed))
flg (cdr (assoc 70 ed))
ecs (cdr (assoc 210 ed)))
(if (not clr)
(setq clr 256))
(if (not thk)
(setq thk 0.0))
(cond ((= et "ARC") (arf_arc))
((= et "TRACE") (arf_sol))
((= et "SOLID") (arf_sol))
((= et "LINE") (arf_line))
((= et "CIRCLE") (arf_circle)))
(entdel en)
(princ (strcat "\r" (rtos (/ (* 100 i) slen) 2 0) "% ")))

(command "_.CHPROP" "_All" "" "_C" "BYlayer" "")
(redraw)
(arf_rmd))

(PDot);************ Load Program ***************************************
(defun C:AR () (arf_))
(if arf_ (princ "\nAll Traces To 3DFaces Converter Loaded\n"))
(prin1)
;================== End Program ========================================
(c:ar)

Advertisements