;;; Convert user selected SOLIDs to Outline Polylines (drawn along their edges)
;;; Combined by 2 existing subroutines by Igal Averbuh 2016

;; 3DFacesTo3DPolylines.lsp [command name: 3DF2PL]
;; Replaces all 3DFaces with 3DPolylines drawn along their edges.
;; Draws 3DPolyline on same Layer as each 3DFace, and eliminates original
;; 3DFace(s), but see instructions below to retain source 3DFace(s).
;; Invisibility of any 3DFace edges is lost.
;; Kent Cooper, 29 December 2014

(vl-load-com)

(defun C:3DF ; = 3DFace [to] Line(s)
(/ *error* getdxf doc ss n 3df 3dfdata)

(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(vla-endundomark doc)
(princ)
); defun -- *error*

(defun getdxf (num); get associated value from dxf code entry
(cdr (assoc num 3dfdata))
); defun

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(prompt "\nSelect previous set to convert 3DFaces to Polylines,")
(if (setq ss (ssget "_:L" '((0 . "3DFACE")))); find unlocked 3DFaces in selection
(progn ; 'then'
(repeat (setq n (sslength ss)); incrementer for faces
(setq
3df (ssname ss (setq n (1- n)))
3dfdata (entget 3df)
); setq
(command "_3DPoly"
"_none" (trans (getdxf 10) 0 1)
"_none" (trans (getdxf 11) 0 1)
"_none" (trans (getdxf 12) 0 1)
); command
(if (equal (getdxf 12) (getdxf 13) 1e-6); 3rd & 4th corners coincide [3-sided]
(command "_close"); 'then'
(command (trans (getdxf 13) 0 1) "_close"); 'else' -- 4-sided
); if
(command "_.chprop" (entlast) "" "_layer" (getdxf 8) "")
(entdel 3df); <-- omit or comment-out this line to retain 3DFace(s), and
; remove "_:L" from (ssget) above if you also want to make equivalent
; 3DPolylines of 3DFaces on locked Layers.
); repeat
); progn -- 'then'
(prompt "\nNo unlocked 3DFace(s) selected."); 'else'
); if [valid selection]

(vla-endundomark doc)
(princ)
); defun

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

;================== 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)
" - Convert Selected Traces To 3DFaces ....\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 "\nSelect SOLID Entites")

(setq ss (ssget '((0 . "SOLID"))))

(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) "% ")))
(redraw)
(c:3df)
(setvar "filedia" 1)
(arf_rmd))

(PDot);************ Load Program ***************************************
(defun C:SO () (arf_))
(if arf_ (princ "\nSolids To Outline Polylines Converter Loaded\n"))
(prin1)
;================== End Program ========================================

Advertisements