1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
| (defun c:Ex-sub (/ *error* _sel sd s pts ss cm e i s1)
;;; ==-- Author : Tharwat Al Shoufi --== ;;;
;;; Extrude and extract inside polylines ;;;
(vl-load-com)
(or Doc
(setq Doc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(defun _sel (string)
(progn
(prompt string)
(setq
s (ssget "_+.:s" '((0 . "*POLYLINE") (-4 . "&=") (70 . 1)))
)
)
s
)
(defun *error* (x)
(if cm
(setvar 'cmdecho cm)
)
(vla-Endundomark Doc)
(princ "\n *Cancel*")
)
(setq *elv* (if *elv*
*elv*
1.0
)
*ex* (if *ex*
*ex*
1.0
)
)
(if (and (progn (initget 6)
(setq *elv*
(cond ((getdist
(strcat "\n Specify Elevations "
(strcat " < " (rtos *elv* 2 2) " > :")
)
)
)
(t *elv*)
)
)
)
(progn (initget 6)
(setq *ex*
(cond
((getdist (strcat "\n Specify extrusion height "
(strcat " < " (rtos *ex* 2 2) " > :")
)
)
)
(t *ex*)
)
)
)
(setq sd (ssadd))
(_sel "Select Single outside LWpolyline")
)
(progn
(setq pts (mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (eq (car x) 10))
(entget (ssname s 0))
)
)
)
(if (setq ss
(ssget "WP" pts '((0 . "*POLYLINE") (-4 . "&=") (70 . 1)))
)
(progn
(vla-StartUndoMark Doc)
(setq cm (getvar 'cmdecho))
(setvar 'cmdecho 0)
(entmod (subst (cons 38 *elv*)
(assoc 38 (entget (ssname s 0)))
(entget (ssname s 0))
)
)
(command "_.extrude" s "" *ex*)
(setq s1 (entlast))
(repeat (setq i (sslength ss))
(entmod
(subst
(cons 38 *elv*)
(assoc 38 (setq e (entget (ssname ss (setq i (1- i))))))
e
)
)
(command "_.extrude" (ssname ss i) "" *ex*)
(ssadd (entlast) sd)
)
(command "_.subtract" s1 "" sd "")
(setvar 'cmdecho cm)
(vla-Endundomark Doc)
)
)
)
(princ)
)
(princ "\n Written by Tharwat Al Shoufi")
(princ)
) |
Partager