ivp

Vou postar uma rotina que me livrou de alguns problemas com polilinhas várias vezes, uma rotina que inverte o sentido do caminhamento da polilinha... sim, tem duzias de programinhas por aí que fazem isso, mas os que eu vi (o do POSICAO, por exemplo) só desenham uma nova entidade, apagando a antiga... bem, esta reorganiza os vértices da polilinha, mantendo seu aspecto, espessuras e arcos (no caso de lwpolylines, mas em fim...

clique para ver o código

;uso do método vla-put-coordinates incrementado
(defun put-coordinates2 (ent pts / vla)
  (setq pts (if (= "LWPOLYLINE" (dxf 0 ent))
              (mapcar '3dto2d pts)
              pts)
        pts (apply 'append pts)
        vla (vlax-ename->vla-object (ename-of ent)))
  (vla-put-coordinates vla  (lst2array pts vlax-vbDouble))
  (vlax-release-object vla))

;é um saco ter de escrever isso em todos os programas... 
;transforma uma coordenada 3d em 2d... é, só isso...
(defun 3dto2d (pt)
  (list (car pt) (cadr pt)))

;função inversa do "vlax-safearray->list"
(defun lst2array (lst tipo / tmp)
 (vlax-safearray-fill
    (vlax-make-safearray
      tipo
      (cons 0 (1- (length lst))))
    lst))

;inverte uma polilinha sem mudar os "bulges" (arcos) e "widths"
(defun c:ivp (/ pts ent ss s pts tmp l lpt a b)
  (tbn:error-init (list (list "cmdecho" 0) T))
  (prompt "\nSelecione as polilinhas...\n")
  (setq ss  (ssget '((0 . "*POLYLINE")))
        ivp:sentido (if ivp:sentido ivp:sentido "H")
        s   (initget "H A" 0)
        s   (getkword (strcat
            "\nEscolha o Sentido [Horário, Anti-horário] <"
            (cadr (assoc ivp:sentido
                     '(("H" "Horário")
                       ("A" "Anti-horário"))) )
            ">"))
        s   (if s s ivp:sentido)
        ivp:sentido s
        s   (= "H" s))
  (repeat (if ss (sslength ss) 0)
    (setq ent (ssname ss 0)
          pts (get-points-polig ent))
    (ssdel ent ss)
    (if (/= s (isclockwise pts))
      (if (= "POLYLINE" (DXF 0 ENT))
        (put-coordinates2 ent (reverse pts))
        (progn
          (setq pts (entget ent)
                lpt (sub-list pts
                            (vl-position (assoc 10 pts) pts)
                            (- (length pts)
                   (vl-position
                 (assoc 42 (reverse pts))
                 (reverse pts))
                   1))
                tmp nil)
          (foreach x lpt
            (if (= 42 (car x))
              (setq tmp (cons (reverse (cons x l))
                  tmp)
                    l   nil)
              (setq l (cons x l))))
      (setq a   (mapcar 'car tmp)
        b   (mapcar '(lambda (l) (list (cons 40 (cdr (assoc 41 l)))
                           (cons 41 (cdr (assoc 40 l)))
                           (cons 42 (* -1 (cdr (assoc 42 l))))))
                (mapcar 'cdr tmp))
        tmp (mapcar 'cons a (append (cdr b) (list (car b)))))
          (entmod
        (append
          (sub-list pts 0 (1- (vl-position (assoc 10 pts) pts)))
          (apply 'append tmp)
          (list (assoc 210 pts))))
          (entupd ent)
          ))))
  (tbn:error-restore))

---

Link(s) da(s) subrotina(s) usada(s):

dxf,
3dto2d,
ename-of,
lst2array,
tbn:error-init,
get-points-polig,
isclockwise,
put-coordinates2,
sub-list,
tbn:error-restore

Bom, quem viu percebeu que joguei umas sub-rotinas a mais no código... pra frente farei uso delas então é bom deixar elas à mão!!