Posicao para Civil 3D

Como prometido, uma rotina que usa a collection POINTS do civil 3d, esta rotina converte os pontos de levantamento topográfico inseridos pelo software Posicao, da Manfra para pontos do Civil 3D
ver rotina
(defun c:ptpos2civil (/ ss ent cod pt elev num apt flag xd fun:ents)
  (
tbn:error-init  '(("cmdecho" 0) t))
  (
if aec-pts
    (progn
      (setq fun:ents (lambda (x / p)
                       (
setq x (cdr x)
                             p (vl-string-search "H=" x))
                       (
handent (vl-string-trim " "
                                  (substr x (+ p 3) (- (vl-string-search "DE=" x p) p 2)))))
            ss (ssget '((0 . "POINT") (-3 ("*"))))
            flag (initget "S N" 0)
            flag (getkword "\nApagar os pontos do posição? [Sim, Não] ")
            flag (= "S" (if flag flag "S")))
      (
repeat (if ss (sslength ss) 0)
        (
setq ent  (ssname ss 0)
              xd   (cadr (assoc -3 (entget ent '("*"))))
              cod  (cdaddr xd)
              elev (atof (cdadr xd))
              num  (car xd)
              pt   (cdr (assoc 10 (entget ent)))
              pt   (list (car pt) (cadr pt)))
        
        (
if (and num elev cod pt)
          (
progn
            (setq apt  (vla-add aec-pts (vlax-3d-point pt)))
            (
vlax-put-property apt 'Name num)
            (
vlax-put-property apt 'RawDescription cod)
            (
vlax-put-property apt 'Elevation elev)
            (
if flag
              (foreach x (list ent
                               (fun:ents (nth 4 xd))
                               (
fun:ents (nth 5 xd))
                               (
fun:ents (nth 6 xd)))
                (
if x (entdel x))))
            (
vlax-release-object apt)))
        (
grtext -2 (itoa (sslength ss)))
        (
ssdel ent ss)))
    (
prompt "\nNo Donuts for You!!!!"))
  (
tbn:error-restore t))


Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, aec-pts, tbn:error-restore
Para usar, basta digitar PTPOS2CIVIL na linha de comando (após carregar a rotina, obviamente)

Nenhum comentário:

Postar um comentário