Quem já desenhou uma hachura e, por algum motivo, apagou as linhas que delimitavam esta hachura e depois quiz alterar a dita cuja? Mas sem os contornos, como fazêlo?
é o que esta rotina faz, desenha os contornos que definem esta hachura...
que faz arquitetura deverá usar bastante, pra hachurar as "linhas do terreno"
(defun c:cn2hatch (/ ent lay loop tp pts isclose qtd dg rc
pe nk ncp kv i f c ss)
(tbn:error-init (list (list "cmdecho" 0) t))
(setq ss (ssget '((0 . "HATCH"))))
(repeat (if ss (sslength ss) 0)
(setq ent (ssname ss 0)
ss (ssdel ent ss)
ent (entget ent)
lay (dxf 8 ent)
loop (dxf 91 ent)) ;Number of boundary paths (loops))
(if (/= 1 (dxf 71 ent))
(progn
;remove a informação inicial que é desnecessária:
(while (/= 92 (caar ent)) (setq ent (cdr ent)))
;descarta os "source objects, pois é hatch não associativa
(while (assoc 97 ent)
(setq ent (vl-remove (assoc 97 ent) ent)))
;descarta as Boundary path type flag (bit coded):
(while (assoc 92 ent)
(setq ent (vl-remove (assoc 92 ent) ent)))
(repeat loop
(if ; boundary type = polyline:
(or (and (= 1 (cdar ent)) (= 1 (cdadr ent)))
(= 0 (cdar ent)))
(progn
(setq isclose (cdadr ent)
qtd (cdaddr ent)
pts nil
ent (cdddr ent))
(repeat qtd
(if (= 42 (caadr ent)) ;se tem arco (bulge)
(setq pts (append pts (sub-list ent 0 1))
ent (cddr ent))
(setq pts (append pts (list (car ent)))
ent (cdr ent))))
(entmake
(append
(list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 lay) '(100 . "AcDbPolyline")
(cons 90 qtd) (cons 70 isclose))
pts)))
(progn
;qtd: Number of edges in this boundary path
;(only if boundary is not a polyline)
(setq qtd (cdar ent) ent (cdr ent))
(repeat qtd
;tp: 1 = Line; 2 = Circular arc;
; 3 = Elliptic arc; 4 = Spline
(setq tp (cdar ent) ent (cdr ent))
(cond
((= tp 1)
(entmake (list '(0 . "LINE") (assoc 10 ent)
(assoc 11 ent) (cons 8 lay)))
(setq ent (cddr ent)))
((= tp 2)
(setq i (dxf 50 ent) f (dxf 51 ent) c (dxf 73 ent))
(entmake
(list '(0 . "ARC") '(100 . "AcDbEntity")
(cons 8 lay) '(100 . "AcDbCircle")
(car ent) (cadr ent)
'(100 . "AcDbArc")
(cons 50 (if (= c 1) i (* -1 f)))
(cons 51 (if (= c 1) f (* -1 i)))))
(setq ent (cdr (cddddr ent))))
((= tp 3)
(entmake
(list '(0 . "ELLIPSE") '(100 . "AcDbEntity")
(cons 8 lay) '(100 . "AcDbEllipse")
(car ent) (cadr ent) (caddr ent)
(cons 41 (if (= 1 (dxf 73 ent))
(dxf 50 ent)
(dxf 51 ent)))
(cons 42 (if (= 1 (dxf 73 ent))
(dxf 51 ent)
(dxf 50 ent)))))
(setq ent (cddr (cddddr ent))))
((= tp 4)
(setq dg (cdar ent) ;Degree
rc (cdadr ent) ;Rational
pe (cdaddr ent) ;Periodic
nk (cdr (cadddr ent)) ;Number of knots
ncp (cdr (nth 4 ent)) ;Number of control points
kv (sub-list ent 5 (+ 4 nk)) ;Knot values
pts (sub-list ent (+ 5 nk) (+ 4 nk ncp));Ctrl pt
ent (sub-list ent (+ 5 nk ncp) (1- (length ent))))
(entmake
(append
(list
'(0 . "SPLINE") '(100 . "AcDbEntity")
(cons 8 lay) '(100 . "AcDbSpline")
(cons 70 (logior (* 4 rc) (* 2 pe)))
(cons 71 dg) (cons 72 nk) (cons 73 ncp)
'(74 . 0))
kv
pts)))))))))))
(tbn:error-restore))
Claro, que as linhas não serão exatamente as mesmas de antes, pois se você as apagou, como vou saber em que layers elas estavam? :)
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, sub-list, tbn:error-restore
Nenhum comentário:
Postar um comentário