Cn2Hatch

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