Hi ,
What about flatten by this way !
(defun C:3d2d (/ laylst d lay ss)
;;by GSLS(SS)
(vl-load-com)
;;error handing
(defun ss-errexit (msg)
(command)
(command)
(if (or (= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ msg)
(princ (strcat "\n错误: " msg))
)
(clos)
)
(svos)
(vl-catch-all-apply
'vl-cmdf
(list "UCS" "N" "V" "" "LAYOUT" "N" "Test" "")
)
(setvar "CTAB" "Test")
(setq ss (ssget "x"))
(vl-catch-all-apply
'vl-cmdf
(list "ERASE" ss "" "MVIEW" "F" "" "MSPACE" "")
)
(setq ss (ssget "x"))
(if (not SolProf_bak)
(progn
(setq SolProf_bak T)
(vl-catch-all-apply
'vl-cmdf
(list "SolProf" ss "" "Y" "Y" "N")
)
)
(SolProf ss "" "Y" "Y" "N")
)
(while (setq d (tblnext "LAYER" (null d)))
(setq laylst (cons (cdr (assoc 2 d)) laylst))
)
(setq lay (last (vl-remove-if-not
(function (lambda (x)
(wcmatch x "PV*")
)
)
laylst
)
)
)
(setvar "CTAB" "Model")
(vl-cmdf "UCS" "N" "V" "")
(setq ss (ssget "x" (list (cons 8 lay))))
(vl-file-delete "C:\\TEST.DWG")
(vl-cmdf "wblock" "c:\\TEST.dwg" "" '(0 0 0) ss "");_here , you can change into another acad saving method .
(foreach a laylst
(if (wcmatch a "P[VH]-*")
(vl-cmdf "ERASE" (ssget "X" (list (cons 8 a))) "")
)
)
(vl-catch-all-apply
'vl-cmdf
(list "layout" "D" "TEST" "" "UCS" "W" "")
)
(vl-Catch-All-Apply
'(lambda ()
(vla-Remove
(vla-GetExtensionDictionary
(vla-Get-Layers
(vla-Get-ActiveDocument
(vlax-Get-Acad-Object)
)
)
)
"ACAD_LAYERFILTERS"
)
)
)
(command "_.PURGE" "a" "*" "N")
(clos)
(princ)
)
(princ "/n高山流水3D实体Hidden线框转2D线框程序,命令3D2D")
(princ)
;;;---------------------------------------------------------------------;;;
;; save old sysvar
(defun svos ()
(setq #system# '("OSMODE" "ORTHOMODE" "CLAYER"
"CECOLOR" "PLINEWID" "CELTYPE"
"CMDECHO" "ELEVATION" "PICKSTYLE"
)
#vlale# (mapcar 'getvar #system#)
gsls_olderr *error*
*error* ss-errexit
)
(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
)
;; call old sysvar
(defun clos ()
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(MapCar 'setvar #system# #vlale#)
(setq *error* gsls_olderr)
)