Aller au contenu
  • Qui est en ligne   0 membre, 0 anonyme, 72 invités (Afficher la liste complète)

    • Il n’y a aucun utilisateur enregistré actuellement en ligne

Suggestions de développements

Vous avez l'idée d'un développement pour un logiciel de CAO? Discutez-en ici. Peut être votre idée est-elle partagée par d'autres? Peut être un développeur va-t-il trouver votre idée intéressante...




  • Statistiques des forums

    • Total des sujets
      46,8 k
    • Total des messages
      282,8 k
  • Sujets

  • Messages

    • modification pour prise en charge multilingues. ; source entité affectée au champ ; target champ modifié (defun c:EditFieldObject (/ target fieldCode format source acdoc) (vl-load-com) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-startundomark acdoc) (and (setq target (nentselp "\nSélectionnez un champ d'objet : ")) (setq target (car target)) (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet (vl-string-search "ObjId" format) (setq p (getpoint "\nSélectionnez le nouvel objet : ")) (setq source (car (nentselp p))) (setq fieldCode (gc:FieldCode target source)) (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode)))) (setq target (vlax-ename->vla-object target)) (progn (vla-put-TextString target "") (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format)) (if (or (= (vla-get-objectname target) "AcDbAttribute") (= (vla-get-objectname target) "AcDbMLeader")) (vla-Regen acdoc acActiveViewport)) (setq target (vlax-vla-object->ename target)) (setq elst (entget target)) (if (member (cdr (assoc 0 elst)) '("MULTILEADER")) (and (vl-cmdf "_COTREASSOCIER" target "" p) ) ) ) ) (vla-endundomark acdoc) (princ) ) ;; gc:FieldCode (gile) ;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s) ; ent ENAME Nom d'entité de l'objet ; obj ENAME/nil Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée (defun gc:FieldCode (ent obj / foo elst xdict dict field str) ;;--------------------------------------------------------;; (defun foo (field str / pos fldID objID) (setq pos 0) (if (setq pos (vl-string-search "\\_FldIdx " str pos)) ; Itération des champs de str (while (setq pos (vl-string-search "\\_FldIdx " str pos)) (setq fldId (entget (cdr (assoc 360 field))) field (vl-remove (assoc 360 field) field) str (strcat (substr str 1 pos) (if (setq objID (cdr (assoc 331 fldId))) ; champ d'objet (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx 0" (cdr (assoc 2 fldId))) ; champ d'envrnt (foo fldId (cdr (assoc 2 fldId))) ) (substr str (1+ (vl-string-search ">%" str pos))) ) ) ) str ) ) ;;--------------------------------------------------------;; (setq elst (entget ent)) (if (and (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER")) (setq xdict (cdr (assoc 360 elst))) (setq dict (dictsearch xdict "ACAD_FIELD")) (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT")) ) (setq str (foo field (cdr (assoc 2 field)))) ) ) ; Renvoie ObjectID (string) de ent / "" si objet supprimé (defun GetObjectID (ent / div err) (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err)) (if ent (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString) (vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false) (itoa (vla-get-ObjectId ent)) ) "" ) )  
    • révision du code suite a des message d'erreur. ; source entité affectée au champ ; target champ modifié (defun c:EditFieldObject (/ target fieldCode format source acdoc) (vl-load-com) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-startundomark acdoc) (and (setq target (nentselp "\nSélectionnez un champ d'objet : ")) (setq target (car target)) (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet (vl-string-search "ObjId" format) (setq p (getpoint "\nSélectionnez le nouvel objet : ")) (setq source (car (nentselp p))) (setq fieldCode (gc:FieldCode target source)) (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode)))) (setq target (vlax-ename->vla-object target)) (progn (vla-put-TextString target "") (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format)) (if (or (= (vla-get-objectname target) "AcDbAttribute") (= (vla-get-objectname target) "AcDbMLeader")) (vla-Regen acdoc acActiveViewport)) (setq target (vlax-vla-object->ename target)) (setq elst (entget target)) (if (member (cdr (assoc 0 elst)) '("MULTILEADER")) (and (vl-cmdf "COTREASSOCIER" target "" p) ) ) ) ) (vla-endundomark acdoc) (princ) ) ;; gc:FieldCode (gile) ;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s) ; ent ENAME Nom d'entité de l'objet ; obj ENAME/nil Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée (defun gc:FieldCode (ent obj / foo elst xdict dict field str) ;;--------------------------------------------------------;; (defun foo (field str / pos fldID objID) (setq pos 0) (if (setq pos (vl-string-search "\\_FldIdx " str pos)) ; Itération des champs de str (while (setq pos (vl-string-search "\\_FldIdx " str pos)) (setq fldId (entget (cdr (assoc 360 field))) field (vl-remove (assoc 360 field) field) str (strcat (substr str 1 pos) (if (setq objID (cdr (assoc 331 fldId))) ; champ d'objet (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx 0" (cdr (assoc 2 fldId))) ; champ d'envrnt (foo fldId (cdr (assoc 2 fldId))) ) (substr str (1+ (vl-string-search ">%" str pos))) ) ) ) str ) ) ;;--------------------------------------------------------;; (setq elst (entget ent)) (if (and (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER")) (setq xdict (cdr (assoc 360 elst))) (setq dict (dictsearch xdict "ACAD_FIELD")) (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT")) ) (setq str (foo field (cdr (assoc 2 field)))) ) ) ; Renvoie ObjectID (string) de ent / "" si objet supprimé (defun GetObjectID (ent / div err) (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err)) (if ent (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString) (vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false) (itoa (vla-get-ObjectId ent)) ) "" ) )  
    • version final, sans message d'erreur en cas de selection autre que les type d'objet text, mtext..etc. ; source entité affectée au champ ; target champ modifié (defun c:EditFieldObject (/ target fieldCode format source acdoc) (vl-load-com) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-startundomark acdoc) (and (setq target (nentselp "\nSélectionnez un champ d'objet : ")) (setq target (car target)) (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet (vl-string-search "ObjId" format) (setq p (getpoint "\nSélectionnez le nouvel objet : ")) (setq source (car (nentselp p))) (setq fieldCode (gc:FieldCode target source)) (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode)))) (setq target (vlax-ename->vla-object target)) (progn (vla-put-TextString target "") (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format)) (if (= (vla-get-objectname target) "AcDbAttribute") (vla-Regen acdoc acActiveViewport)) (setq target (vlax-vla-object->ename target)) (setq elst (entget target)) (if (member (cdr (assoc 0 elst)) '("MULTILEADER")) (vl-cmdf "COTREASSOCIER" target "" p "")) ) ) (vla-endundomark acdoc) (vla-Regen acdoc acActiveViewport) (princ) ) ;; gc:FieldCode (gile) ;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s) ; ent ENAME Nom d'entité de l'objet ; obj ENAME/nil Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée (defun gc:FieldCode (ent obj / foo elst xdict dict field str) ;;--------------------------------------------------------;; (defun foo (field str / pos fldID objID) (setq pos 0) (if (setq pos (vl-string-search "\\_FldIdx " str pos)) ; Itération des champs de str (while (setq pos (vl-string-search "\\_FldIdx " str pos)) (setq fldId (entget (cdr (assoc 360 field))) field (vl-remove (assoc 360 field) field) str (strcat (substr str 1 pos) (if (setq objID (cdr (assoc 331 fldId))) ; champ d'objet (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx 0" (cdr (assoc 2 fldId))) ; champ d'envrnt (foo fldId (cdr (assoc 2 fldId))) ) (substr str (1+ (vl-string-search ">%" str pos))) ) ) ) str ) ) ;;--------------------------------------------------------;; (setq elst (entget ent)) (if (and (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER")) (setq xdict (cdr (assoc 360 elst))) (setq dict (dictsearch xdict "ACAD_FIELD")) (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT")) ) (setq str (foo field (cdr (assoc 2 field)))) ) ) ; Renvoie ObjectID (string) de ent / "" si objet supprimé (defun GetObjectID (ent / div err) (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err)) (if ent (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString) (vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false) (itoa (vla-get-ObjectId ent)) ) "" ) )  
    • une autre amélioration avec le réassociation des multileader avec l'objet source. ; source entité affectée au champ ; target champ modifié (defun c:EditFieldObject (/ target fieldCode format source acdoc) (vl-load-com) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-startundomark acdoc) (and (setq target (nentselp "\nSélectionnez un champ d'objet : ")) (setq p (getpoint "\nSélectionnez le nouvel objet : ")) (setq target (car target)) (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet (vl-string-search "ObjId" format) (setq source (car (nentselp p))) (setq fieldCode (gc:FieldCode target source)) (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode)))) (setq target (vlax-ename->vla-object target)) (progn (vla-put-TextString target "") (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format)) (if (= (vla-get-objectname target) "AcDbAttribute") (vla-Regen acdoc acActiveViewport)) ) ) (setq target (vlax-vla-object->ename target)) (setq elst (entget target)) (if (member (cdr (assoc 0 elst)) '("MULTILEADER")) (vl-cmdf "COTREASSOCIER" target "" p "") ) (vla-endundomark acdoc) (vla-Regen acdoc acActiveViewport) (princ) ) ;; gc:FieldCode (gile) ;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s) ; ent ENAME Nom d'entité de l'objet ; obj ENAME/nil Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée (defun gc:FieldCode (ent obj / foo elst xdict dict field str) ;;--------------------------------------------------------;; (defun foo (field str / pos fldID objID) (setq pos 0) (if (setq pos (vl-string-search "\\_FldIdx " str pos)) ; Itération des champs de str (while (setq pos (vl-string-search "\\_FldIdx " str pos)) (setq fldId (entget (cdr (assoc 360 field))) field (vl-remove (assoc 360 field) field) str (strcat (substr str 1 pos) (if (setq objID (cdr (assoc 331 fldId))) ; champ d'objet (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx 0" (cdr (assoc 2 fldId))) ; champ d'envrnt (foo fldId (cdr (assoc 2 fldId))) ) (substr str (1+ (vl-string-search ">%" str pos))) ) ) ) str ) ) ;;--------------------------------------------------------;; (setq elst (entget ent)) (if (and (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER")) (setq xdict (cdr (assoc 360 elst))) (setq dict (dictsearch xdict "ACAD_FIELD")) (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT")) ) (setq str (foo field (cdr (assoc 2 field)))) ) ) ; Renvoie ObjectID (string) de ent / "" si objet supprimé (defun GetObjectID (ent / div err) (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err)) (if ent (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString) (vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false) (itoa (vla-get-ObjectId ent)) ) "" ) )  
    • La fonction dumpallproperties permet de connaitre toutes les propriétés accessible avec getpropertyvalue ou getpropertyvalue pour l'objet passé en argument (le résultat s'affiche dans la fenêtre de texte (F2)). Pour sélectionner un attribut de bloc, tu peux utiliser nentsel : (dumpallproperties (car (nentsel)))  
  • Sujets

×
×
  • Créer...