movetotop

Faz tempo que não posto nada, por isso aí vai uma rotinazinha simples que usa o método MoveToTop do activex, ou seja, vla-movetotop. Na verdade é o mesmo que um draworder trazendo a entidade pra frente... mas vai servir de exemplo para quem ainda não sabe como usar safearray

vera rotina...

(defun movetotop (ent / tmp sort)
  (if (and vla-movetotop (setq ent (ename-of ent))) ;cad2007 e a entidade existe?
    (progn 
      (setq tmp (vla-GetExtensionDictionary (get-activespace))
            ent (vlax-ename->vla-object ent))
      (if (vl-catch-all-error-p ;pega ou cria o dictionary do draworder
            (setq sort (vl-catch-all-apply 'vla-item (list tmp "ACAD_SORTENTS"))))
        (setq sort (vla-AddObject tmp "ACAD_SORTENTS" "AcDbSortentsTable")))
      (vla-movetotop sort
        (vlax-make-variant ;|cria uma array com a entidade... se tivesse uma
selectionset, teria de trasformar ela numa lista e substituir abaixo|;
            (vlax-safearray-fill 
              (vlax-make-safearray ;cria uma safearray
                vlax-vbObject ; de vla
               '(0 . 0)) ;com a dimensao 0 igual a 0 (uma entidade)
              (list ent)))) ;lista a ser usada para preeencher a safearray
      (mapcar 'vlax-release-object (list ent sort tmp)) ;discutivel a utilidade disso
)))

---

Link(s) da(s) subrotina(s) usada(s):ename-of, get-activespace

get-center-3p

Uma rotina para calcular o centro da circunferência que passa por três pontos conhecidos: expandir...

(defun get-center-3p ( p1 p2 p3 / a1 a2 m1 m2)
  (setq a1 (angle p1 p2)
        a2 (angle p2 p3)
        m1 (polar p1 a1 (/ (distance p1 p2) 2))
        m2 (polar p2 a2 (/ (distance p2 p3) 2)))
  (inters m1 (polar m1 (+ a1 (/ pi 2)) 1)
          m2 (polar m2 (+ a2 (/ pi 2)) 1)
          nil))

útil em algumas rotinas que postarei mais adiante...

Minsert para Insert

Uma rotinazinha bem simples que quebrou um galhao outro dia:

---

(defun c:mins2ins (/ ent elist)
  (vl-load-com)
  (if (setq ss (ssget '((0 . "INSERT"))))
     (repeat (sslength ss)
       (setq ent   (ssname ss 0)
             elist (entget ent '("*")))
       (foreach x '(44 45 70 71)
         (setq elist
             (vl-remove (assoc x elist) elist)))
       (entmake elist)
       (entdel ent)
       (ssdel ent ss)))
  (princ))

---

ela transforma blocos "MINSERT" (que não são afetados pelo comando explode)para "INSERT" normal