VLisp Copier les Donnees Etendues (AutoCAD Architecture/MEP)

[PHILPHIL]

bonjour

voici un LISP pour autocad architecture qui permet de copier des données étendues entre entites placer dans le meme calque que l'entite source

une définition de jeu de propriété par type d'objet est requis, sinon  le lisp va s'enmeller les pinceaux je pense.

a tester

Phil

 

;;;---------------------------------------------------------
;;;copier des données étendues d une entites a dautres
;;;---------------------------------------------------------

(defun c:copier_donnee_etendue ( / COM COMPT DIC DICO1 DICO2 DICOPARAVALUE DICOPARAVALUE1 LISTDONETEN LISTDONETEN1 NOMPROP OBJ OSM PROPERTIES2 PROPSET2 PROPSETS PSD SCHEDAPP SELINSERT TYPEOBJ VALPROP VLAOBJ )
  (setvar "cmdecho" 0)
  (setq osm (getvar "osmode"))

 (setq table1 (ssget "X" (list (cons 0 "AEC_SCHEDULE_TABLE"))))
 (if (/= table1  nil)
 (progn
 (setq compt 0)
  (setq com (sslength table1))
  (while (< compt com)
    (vlax-put-property (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname table1 compt))))) 'AutoUpdate 0)
    (setq compt (1+ compt))
  )
)
  )
 
  (setq obj (entsel "CLIQUER SUR L'ENTITE DE REFERENCE : "))
  (setq vlaobj (vlax-ename->vla-object (car obj)))
  (setq typeobj  (cdr (assoc 0 (entget (car obj))))
        TYPECALK (cdr (assoc 8 (entget (car obj))))
        )
  (setq acadobj (vlax-get-acad-object))
  (setq schedapp (vla-getinterfaceobject acadobj "AecX.AecScheduleApplication.8.5"))
  (setq propsets (vlax-invoke-method schedapp 'propertysets vlaobj))
  (setq psd (dictsearch (namedobjdict) "AEC_PROPERTY_SET_DEFS"))
  (setq dico1 nil)
  (foreach ele psd
    (if (= (car ele) 3)
      (setq dico1 (cons (cdr ele) dico1))
    )
  )
  (setq dico2 nil)
  (foreach di dico1
    (if (/= (vlax-invoke-method propsets 'item di) nil)
      (setq dico2 (cons di dico2))
    )
  )
  (setq dicoparavalue nil)
  (foreach di2 dico2
    (progn (setq propset2 (vlax-invoke-method propsets 'item di2))
           (setq properties2 (vlax-get-property propset2 'properties))
           (vlax-for prop properties2
             (if (/= (vlax-get-property prop 'automatic) :vlax-true)
               (setq dicoparavalue (cons (cons (vlax-get-property prop 'name) (vlax-variant-value (vlax-get-property prop 'value)))
                                         dicoparavalue
                                   )
               )
             )
           )
    )
  )
  (setq dicoparavalue1 (vl-sort dicoparavalue (function (lambda (p1 p2) (< (car p1) (car p2))))))
  (prompt "\nSELECTIONNER LES ENTITES A MODIFIER:")
  (setq selinsert (ssget (list (cons 0 typeobj) (cons 8 typeCALK)    )))
  (setq com (sslength selinsert))
  (boitepropetendue1)
;;;  (decomptedebut)
  (setq listdoneten1 nil)
  (foreach lde listdoneten
    (foreach dpv1 dicoparavalue1
      (if (= (car dpv1) lde)
        (setq listdoneten1 (cons dpv1 listdoneten1))
      )
    )
  )
  (setvar "CURSORSIZE" 100)
  (setq compt 0)
  (setq dic (nth 0 dico2))
  (acet-ui-progress-init "AVANCEMENT" com)
  (while (< compt com)
    (foreach bidyn listdoneten1
      (progn (setq nomprop (car bidyn)
                   valprop (cdr bidyn)
             )
             (command-s "_-aecpropertydataedit" (ssname selinsert compt) "" (strcat dic ":" nomprop) valprop "")
      )
    )
    (acet-ui-progress-init (strcat "AVANCEMENT " (rtos (/ (* compt 100) (float com)) 2 2) " %") com)
    (acet-ui-progress-safe compt)
    (setq compt (1+ compt))
  )
  (acet-ui-progress-done)
(if (/= table1  nil)
 (progn
 (setq compt 0)
  (setq com (sslength table1))
  (while (< compt com)
    (vlax-put-property (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname table1 compt))))) 'AutoUpdate -1)
    (setq compt (1+ compt))
  )
)
  )


 
;;;  (decomptefin)
  (setvar "osmode" osm)
)





(defun boitepropetendue1 (/ tmp file fuzz ret pn av dcl_id val)
  (setq tmp  (vl-filename-mktemp "Tmp.dcl")
        file (open tmp "w")
        ret  nil
  )
  (write-line (strcat "DynBlkProps:dialog{label=\"ENTITES A MODIFIER\";"
                      "
              :text{label=\"NOM DE L'ENTITE SOURCE : \""
                      (vl-prin1-to-string typeobj)
                      ";}
              :text{label=\"Nombre d'entites sélectionnées : "
                      (itoa com)
                      "\"; }

              :boxed_column{label=\"DONNEES ETENDUES\";"
              )
              file
  )
  (foreach pn dicoparavalue1
    (progn (if (= (numberp (cdr pn)) nil)
             (setq lab1 (strcat (car pn) "  =  " (cdr pn)))
             (setq lab1 (strcat (car pn) "  =  " (rtos (cdr pn) 2)))
           )
           (setq test33 (car pn))
           (write-line (strcat ":row{:toggle {label =" (vl-prin1-to-string lab1) ";key = \"" (car pn) "\";value=\"0\";}}")
                       file
           )
    )
  )
  (write-line ":row{:button{key=\"tout\";label=\"TOUT\";}:button{key=\"aucun\";label=\"Aucun\";}}"
              file
  )
  (write-line "}spacer;ok_cancel;}" file)
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "DynBlkProps" dcl_id))
    (exit)
  )
  (action_tile "tout" "(foreach pn dicoparavalue1 (set_tile (car pn) \"1\" ) )")
  (action_tile "aucun" "(foreach pn dicoparavalue1 (set_tile (car pn) \"0\" ))")
  (action_tile
    "accept"
    "(foreach p dicoparavalue1
(if (assoc (car p ) POP2)
(setq val (nth (atoi (get_tile (car p ))) (cdr (assoc (car p ) POP2))))
(setq val (get_tile (car p ))))

(if (and val (/= val \"\"))
(setq ret (cons (cons (car p ) val) ret)))
)
(and (not ret) (setq ret T))
(done_dialog)"
  )
  (action_tile "cancel" "(setq ret nil)")
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  (setq listdoneten nil)
  (foreach p ret
    (if (= (atoi (cdr p)) 1)
      (setq listdoneten (cons (car p) listdoneten))
    )
  )
)