Alles chercher un block dans un template.

CadFrank · le 11 octobre 2012

;;; gc:GetAxDbDoc
;;; Accéder à un dessin fermé.
;;; Version compatible A2013 utilise les fonctions de irneb @ TheSwamp
;;; DLLRegister, ProgID->ClassID et DBX-Register
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
;;;
;;; Retourne :
;;; un objet IAxDbDocument si le document est trouve
;;; nil si le document n'a pu être trouvé ou s'il est ouvert.
;;;
;;; Argument :
;;; Le chemin complet du fichier
;;;
;;; Exemple d'utilisation :
;;; (if (setq doc (gc:GetAxDbDoc filename))
;;;   (progn
;;;     ...
;;;     ...
;;;     (vlax-release-object doc)
;;;   )
;;; )

(defun gc:GetAxDbDoc (filename / classname axdbdoc)
 (vl-load-com)
 (if (and
       (setq classname (DBX-Register nil nil))
       (setq axdbdoc (vlax-create-object className))
     )
   (if (vl-catch-all-apply
         'vla-open
         (list axdbdoc filename)
       )
     (not (vlax-release-object axdbdoc))
     axdbdoc
   )
 )
)


;;; Calls REGSVR32 to Register a DLL silently
;;; irneb @ TheSwamp
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
(defun DLLRegister (dll) (startapp "regsvr32.exe" (strcat "/s \"" dll "\"")))

;;; Returns the ProgID for a given ClassID if found in registry
;;; irneb @ TheSwamp
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
(defun ProgID->ClassID (ProgID) (vl-registry-read (strcat "HKEY_CLASSES_ROOT\\" progid "\\CLSID")))

;;; Try to Register ObjectDBX if not done so already
;;; Returns the Class Name if already registered / sucessfully registered
;;; Else returns nil if failure
;;; irneb @ TheSwamp
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
(defun DBX-Register (classname filename / server acver)
 (cond
   ((not (and classname filename))
    (DBX-Register
      (strcat "ObjectDBX.AxDbDocument." (itoa (setq acver (atoi (getvar 'ACadVer)))))
      (strcat "AxDb" (itoa acver) ".dll")
    )
   )
   ((ProgID->ClassID classname) classname)
   ((setq server (findfile filename))
    (cond
      ((and (DLLRegister server) (ProgID->ClassID classname)) classname)
      (t nil)
    )
   )
   (t (DBX-Register "ObjectDBX.AxDbDocument" "AxDb.dll"))
 )
)

;; GetItem
;; Retourne le vla-object de l'item s'il est présent dans la collection (ou nil).
;;
;; Arguments
;; col : la collection (vla-object)
;; name : le nom de l'objet (string) ou son indice (entier)

(defun gc:GetItem (col name / obj)
 (vl-catch-all-apply
   (function (lambda () (setq obj (vla-Item col name))))
 )
 obj
)

;; gc:ImportBlock
;; Importe le bloc dans le dessin courant depuis le fichier.
;;
;; Retourne
;; T si l'opération a réussi, nil sinon.
;;
;; Arguments
;; blockName : le nom du bloc à importer
;; filename : le nom du fichier source
;;            (le chemin complet si le fichier n'est pas dans les chemins de recherche)
(defun gc:ImportBlock (blockName filename / file doc blk)
 (vl-load-com)
 (if
   (and
     (setq file (findfile filename))
     (setq doc (gc:GetAxDbDoc filename))
   )
   (progn
     (if (setq blk (gc:GetItem (vla-get-Blocks doc) blockName))
       (not
         (vlax-invoke
           doc
           'CopyObjects
           (list blk)
           (vla-get-Blocks
             (vla-get-ActiveDocument (vlax-get-acad-object))
           )
         )
       )
     )
     (vlax-release-object doc)
   )
 )
)

;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦;
;¦¦¦                   CE PROGRAM EST CONÇU POUR COFFRER                     ¦¦¦;
;¦¦¦                          UNE DALLE DE BÉTON                             ¦¦¦;
;¦¦¦ _______________________________________________________________________ ¦¦¦;

;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦;
;¦¦¦                   AUTEUR : CadFrank, Copyright ® 2012                   ¦¦¦;
;¦¦¦ _______________________________________________________________________ ¦¦¦;





;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦;
;¦¦¦                           PROGRAM PRINCIPAL                             ¦¦¦;
;¦¦¦ _______________________________________________________________________ ¦¦¦;

(defun c:cofd (/ pt1 pt2 pt3 pt4 pt5 dist1 div1 div2 div3 div4 espac1 d-sol i)

 (setq pt1 (getpoint "\n Selectionner le premier point : "))
 (setq pt2 (getpoint pt1 "\n Sélectionner le deuxième point : "))

 (setq pt3 (list (car pt2) (- (cadr pt2) 20)))
 
 (if (> (car pt1) (car pt2))
   (progn
     (setq pt4 (list (- (car pt1) 65) (- (cadr pt1) 20)))
     (setq pt5 (list (+ (car pt2) 65) (- (cadr pt2) 20)))
   )

   (progn
     (setq pt4 (list (+ (car pt1) 65) (- (cadr pt1) 20)))
     (setq pt5 (list (- (car pt2) 65) (- (cadr pt2) 20)))
   )
 )

 (setq dist1 (distance (list (car pt4) (cadr pt4))
                       (list (car pt5) (cadr pt5))))

 (setq espac1 (getreal "\n Déterminer l'espacement maximale des solives [400] : "))
 (or espac1 (setq espac1 400))
 
 
 (initget 1 "4x4 A")
 (setq d-sol (getkword "\n Choisir le type de solive [4x4/Aluma] "))

 (if (= d-sol "4x4")

   (progn
     
     (not (tblsearch "BLOCK" "4x4"))
     (entmake '((0 . "BLOCK") (2 . "*U") (10 45 90 0) (70 . 1)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 0 0) (11 90 0)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 90 0) (11 90 90)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 90 90) (11 0 90)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 0 90) (11 0 0)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 0 0) (11 90 90)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 90 0) (11 0 90)))
     (setq blkb (entmake '((0 . "ENDBLK") (8 . "-LU BOIS"))))

   )

   (progn
     
     ;(not (tblsearch "BLOCK" "ALUMA")
   ;(gc:ImportBlock "ALUMA" "cadre.dwt"))
     (setq blkb "ALUMA")

   )
   
 )  
 
 (setq div1 (/ dist1 espac1))
 (setq div2 (1+ div1))
 (setq div3 (fix div2))
 (setq div4 (/ dist1 div3))
 (setq i 1)

 (setvar "clayer" "-LU CONTREPLAQUE")
 
 (command "_rectangle" pt1 pt3)
 
   (repeat (1- div3)
     
    (entmake (list (cons 0 "INSERT")(cons 2 blkb)
                   (cons 10 (polar pt3 (angle pt3 pt4) (* div4 i)))
                   (cons 41 1)
                   (cons 42 1)
                   (cons 43 1)))
    (setq i (1+ i)))

 (prin1)
 
);fin

(gile) · le 11 octobre 2012

Salut,

C'est faisable avec ObjectDbx.

Je te propose ces quelques routines.

gc:ImportBlock retourne T si l'importation du bloc s'est bien passé, nil sinon.

Tu peux donc l'utiliser dans une expression (if (gc:ImportBlock ...) ...) pour gérer une éventuelle erreur.

Code modifié suite à la remarque de Patrick_35

;;; gc:GetAxDbDoc
;;; Accéder à un dessin fermé.
;;; Version compatible A2013 utilise les fonctions de irneb @ TheSwamp
;;; DLLRegister, ProgID->ClassID et DBX-Register
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
;;;
;;; Retourne :
;;; un objet IAxDbDocument si le document est trouve
;;; nil si le document n'a pu être trouvé ou s'il est ouvert.
;;;
;;; Argument :
;;; Le chemin complet du fichier
;;;
;;; Exemple d'utilisation :
;;; (if (setq doc (gc:GetAxDbDoc filename))
;;;   (progn
;;;     ...
;;;     ...
;;;     (vlax-release-object doc)
;;;   )
;;; )

(defun gc:GetAxDbDoc (filename / classname axdbdoc)
 (vl-load-com)
 (if (and
(setq classname (DBX-Register nil nil))
(setq axdbdoc (vlax-create-object className))
     )
   (if	(vl-catch-all-apply
  'vla-open
  (list axdbdoc filename)
)
     (not (vlax-release-object axdbdoc))
     axdbdoc
   )
 )
)


;;; Calls REGSVR32 to Register a DLL silently
;;; irneb @ TheSwamp
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
(defun DLLRegister (dll) (startapp "regsvr32.exe" (strcat "/s \"" dll "\"")))

;;; Returns the ProgID for a given ClassID if found in registry
;;; irneb @ TheSwamp
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
(defun ProgID->ClassID (ProgID) (vl-registry-read (strcat "HKEY_CLASSES_ROOT\\" progid "\\CLSID")))

;;; Try to Register ObjectDBX if not done so already
;;; Returns the Class Name if already registered / sucessfully registered
;;; Else returns nil if failure
;;; irneb @ TheSwamp
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
(defun DBX-Register (classname filename / server acver)
 (cond
   ((not (and classname filename))
    (DBX-Register
      (strcat "ObjectDBX.AxDbDocument." (itoa (setq acver (atoi (getvar 'ACadVer)))))
      (strcat "AxDb" (itoa acver) ".dll")
    )
   )
   ((ProgID->ClassID classname) classname)
   ((setq server (findfile filename))
    (cond
      ((and (DLLRegister server) (ProgID->ClassID classname)) classname)
      (t nil)
    )
   )
   (t (DBX-Register "ObjectDBX.AxDbDocument" "AxDb.dll"))
 )
)

;; GetItem
;; Retourne le vla-object de l'item s'il est présent dans la collection (ou nil).
;;
;; Arguments
;; col : la collection (vla-object)
;; name : le nom de l'objet (string) ou son indice (entier)

(defun gc:GetItem (col name / obj)
 (vl-catch-all-apply
   (function (lambda () (setq obj (vla-Item col name))))
 )
 obj
)

;; gc:ImportBlock
;; Importe le bloc dans le dessin courant depuis le fichier.
;;
;; Retourne
;; T si l'opération a réussi, nil sinon.
;;
;; Arguments
;; blockName : le nom du bloc à importer
;; filename : le nom du fichier source
;;            (le chemin complet si le fichier n'est pas dans les chemins de recherche)
(defun gc:ImportBlock (blockName filename / file doc blk)
 (vl-load-com)
 (if
   (and
     (setq file (findfile filename))
     (setq doc (gc:GetAxDbDoc filename))
   )
   (progn
     (if (setq blk (gc:GetItem (vla-get-Blocks doc) blockName))
(not
  (vlax-invoke
    doc
    'CopyObjects
    (list blk)
    (vla-get-Blocks
      (vla-get-ActiveDocument (vlax-get-acad-object))
    )
  )
)
     )
     (vlax-release-object doc)
   )
 )
)

CadFrank · le 11 octobre 2012

Je regarde le tout et sa me semble complexe. Est-ce que je dois Changer filename par le nom du fichier du genre "cadre.dwt" et BlockName par "Aluma" ?

ou bien le programme le trouve?

(gile) · le 11 octobre 2012

Est-ce que je dois Changer filename par le nom du fichier du genre "cadre.dwt" et BlockName par "Aluma" ?

Oui, La fonction gc:ImportBlock requiert deux arguments comme la fonction native distance, par exemple, qui requiert deux points.

Tu l'appelle en faisant :

(gc:ImportBlock "Aluma" "cadre.dwt")

Les autres routines doivent être chargées parce qu'elles sont appelées par gc:ImportBlock.

Patrick_35 · le 12 octobre 2012

Salut (gile)

A lecture de ton lisp, ce message indique qu'objectdbx, sur ta version actuelle, ne fonctionne pas forcement sur une A2013.

@+

(gile) · le 12 octobre 2012

Patric_35,

Merci pour ta remarque. Je vois que même Visual LISP est affecté par le "Big Split" de 2013.

CadFrank,

Désolé, mais finalement ça s'avère encore plus "complexe"... Du moins pour accéder à un dessin fermé, pour toi, ça ne change pas l'utilisation de la routine gc:ImportBlock (toutes les autres doivent aussi être chargées).

CadFrank · le 12 octobre 2012

Donc je peux l'utiliser... ?

(gile) · le 12 octobre 2012

Bien sûr !

CadFrank · le 12 octobre 2012

Bien Merci ! Je me demandais y a-t-il quelqu'un de québec sur ce forum :D

CadFrank · le 12 octobre 2012

Bon et bien j'ai modifier mon code du début avec se que je pensais qui allais fonctionner.

Maintenant, on m'affiche un code d'erreur.

; error: bad function: "cadre.dwt"

Donc je ne suis par sur quoi faire rendu la ! p-e que la maniere dont j'ai ecrit la portion de code qui manquais.

(gile) · le 12 octobre 2012

Remplace :

(findfile (filename))

par

(finfile filename)

pierrevigneux · le 12 octobre 2012

Bien Merci ! Je me demandais y a-t-il quelqu'un de québec sur ce forum :D

Quelqu'un de sherbrooke peut-être!

Salut !

CadFrank · le 15 octobre 2012

AARRRGGG ! Je comprend pas pourquoi mon rectangle se fais au pt2 et non au pt3... !

On dirait que le code ne garde pas en mémoire le pt3 je ne sait pas trop.

CadFrank · le 15 octobre 2012

Ah c'est une vrai joke!! pourquoi j'ai pas penser a 'osmode ... Je suis bête des fois

CadFrank · le 15 octobre 2012

bon maintenant j'ai un code d'erreur !!

; error: too many arguments

;;; gc:GetAxDbDoc
;;; Accéder à un dessin fermé.
;;; Version compatible A2013 utilise les fonctions de irneb @ TheSwamp
;;; DLLRegister, ProgID->ClassID et DBX-Register
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
;;;
;;; Retourne :
;;; un objet IAxDbDocument si le document est trouve
;;; nil si le document n'a pu être trouvé ou s'il est ouvert.
;;;
;;; Argument :
;;; Le chemin complet du fichier
;;;
;;; Exemple d'utilisation :
;;; (if (setq doc (gc:GetAxDbDoc filename))
;;;   (progn
;;;     ...
;;;     ...
;;;     (vlax-release-object doc)
;;;   )
;;; )

(defun gc:GetAxDbDoc (filename / classname axdbdoc)
 (vl-load-com)
 (if (and
       (setq classname (DBX-Register nil nil))
       (setq axdbdoc (vlax-create-object className))
     )
   (if (vl-catch-all-apply
         'vla-open
         (list axdbdoc filename)
       )
     (not (vlax-release-object axdbdoc))
     axdbdoc
   )
 )
)


;;; Calls REGSVR32 to Register a DLL silently
;;; irneb @ TheSwamp
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
(defun DLLRegister (dll) (startapp "regsvr32.exe" (strcat "/s \"" dll "\"")))

;;; Returns the ProgID for a given ClassID if found in registry
;;; irneb @ TheSwamp
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
(defun ProgID->ClassID (ProgID) (vl-registry-read (strcat "HKEY_CLASSES_ROOT\\" progid "\\CLSID")))

;;; Try to Register ObjectDBX if not done so already
;;; Returns the Class Name if already registered / sucessfully registered
;;; Else returns nil if failure
;;; irneb @ TheSwamp
;;; http://www.theswamp.org/index.php?topic=40871.msg461180#msg461180
(defun DBX-Register (classname filename / server acver)
 (cond
   ((not (and classname filename))
    (DBX-Register
      (strcat "ObjectDBX.AxDbDocument." (itoa (setq acver (atoi (getvar 'ACadVer)))))
      (strcat "AxDb" (itoa acver) ".dll")
    )
   )
   ((ProgID->ClassID classname) classname)
   ((setq server (findfile filename))
    (cond
      ((and (DLLRegister server) (ProgID->ClassID classname)) classname)
      (t nil)
    )
   )
   (t (DBX-Register "ObjectDBX.AxDbDocument" "AxDb.dll"))
 )
)

;; GetItem
;; Retourne le vla-object de l'item s'il est présent dans la collection (ou nil).
;;
;; Arguments
;; col : la collection (vla-object)
;; name : le nom de l'objet (string) ou son indice (entier)

(defun gc:GetItem (col name / obj)
 (vl-catch-all-apply
   (function (lambda () (setq obj (vla-Item col name))))
 )
 obj
)

;; gc:ImportBlock
;; Importe le bloc dans le dessin courant depuis le fichier.
;;
;; Retourne
;; T si l'opération a réussi, nil sinon.
;;
;; Arguments
;; blockName : le nom du bloc à importer
;; filename : le nom du fichier source
;;            (le chemin complet si le fichier n'est pas dans les chemins de recherche)
(defun gc:ImportBlock (blockName filename / file doc blk)
 (vl-load-com)
 (if
   (and
     (setq file (findfile filename))
     (setq doc (gc:GetAxDbDoc filename))
   )
   (progn
     (if (setq blk (gc:GetItem (vla-get-Blocks doc) blockName))
       (not
         (vlax-invoke
           doc
           'CopyObjects
           (list blk)
           (vla-get-Blocks
             (vla-get-ActiveDocument (vlax-get-acad-object))
           )
         )
       )
     )
     (vlax-release-object doc)
   )
 )
)

;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦;
;¦¦¦                   CE PROGRAM EST CONÇU POUR COFFRER                     ¦¦¦;
;¦¦¦                          UNE DALLE DE BÉTON                             ¦¦¦;
;¦¦¦ _______________________________________________________________________ ¦¦¦;

;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦;
;¦¦¦                   AUTEUR : CadFrank, Copyright ® 2012                   ¦¦¦;
;¦¦¦ _______________________________________________________________________ ¦¦¦;

;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦;
;¦¦¦                   Ce sous-program défini les calques                    ¦¦¦;
;¦¦¦ _______________________________________________________________________ ¦¦¦;

(defun NouveauCalque(/ lay)

 (foreach lay '("-LU BOIS" "-LU CONTREPLAQUE")
    (if (not (tblsearch "LAYER" lay))
        
      (progn
        (command "_layer" "_n" "-LU BOIS" "_C" "41" "-LU BOIS" "" "")
 (Command "_layer" "_n" "-LU CONTREPLAQUE" "_C" "40" "-LU CONTREPLAQUE" "" "")    
      )
     
    );if

 );foreach

); fin NouveauCalque

;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦;
;¦¦¦                        Ce sous-program défini les                       ¦¦¦;
;¦¦¦                            parametres initial                           ¦¦¦;
;¦¦¦ _______________________________________________________________________ ¦¦¦;

(defun Parametreinitial ()

 (setq retour (list
                (cons "osmode" (getvar 'osmode))
                (cons "clayer" (getvar 'clayer))
              )
 )
 (setvar 'OSMODE 0)
   
 retour ; la dernière expression est retournée par la fonction

); fin parametreinitial

;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦;
;¦¦¦                        Ce sous-program remet les                        ¦¦¦;
;¦¦¦                            parametres initial                           ¦¦¦;
;¦¦¦ _______________________________________________________________________ ¦¦¦;

(defun Parametrefin (retour)

 (foreach p retour
   (setvar (car p) (cdr p))
 )

);fin parametrefin

;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦;
;¦¦¦                           PROGRAM PRINCIPAL                             ¦¦¦;
;¦¦¦ _______________________________________________________________________ ¦¦¦;

(defun c:cofd (/ pt1 pt2 p1 pt4 pt5 dist1 div1 div2 div3 div4 espac1 d-sol i)

 (NouveauCalque)
 
 (setq pt1 (getpoint "\n Selectionner le premier point : "))
 (setq pt2 (getpoint pt1 "\n Sélectionner le deuxième point : "))
 
 (setq init (Parametreinitial))
 
 (setq pt3 (list (car pt2) (- (cadr pt2) 20) 0))

 (setvar "clayer" "-LU CONTREPLAQUE")
 
 (command "_rectangle" pt1 pt3)
 
 (if (> (car pt1) (car pt2))
   (progn
     (setq pt4 (list (- (car pt1) 65) (- (cadr pt1) 20)))
     (setq pt5 (list (+ (car pt2) 65) (- (cadr pt2) 20)))
   )

   (progn
     (setq pt4 (list (+ (car pt1) 65) (- (cadr pt1) 20)))
     (setq pt5 (list (- (car pt2) 65) (- (cadr pt2) 20)))
   )
 )

 (setq dist1 (distance (list (car pt4) (cadr pt4))
                       (list (car pt5) (cadr pt5))))

 (setq espac1 (getreal "\n Déterminer l'espacement maximale des solives [400] : "))
 (or espac1 (setq espac1 400))
 
 
 (initget 1 "4x4 A")
 (setq d-sol (getkword "\n Choisir le type de solive [4x4/Aluma] "))

 (if (= d-sol "4x4")

   (progn
     
     (not (tblsearch "BLOCK" "4x4"))
     (entmake '((0 . "BLOCK") (2 . "*U") (10 45 90 0) (70 . 1)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 0 0) (11 90 0)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 90 0) (11 90 90)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 90 90) (11 0 90)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 0 90) (11 0 0)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 0 0) (11 90 90)))
     (entmake '((0 . "LINE") (8 . "-LU BOIS") (10 90 0) (11 0 90)))
     (setq blkb (entmake '((0 . "ENDBLK") (8 . "-LU BOIS"))))

   )

   (progn
     
     (setq blkb "ALUMA")
     
     (not (tblsearch "BLOCK" blkb)
          (gc:ImportBlock "ALUMA" "cadre.dwt")
          
     )
     
   )
   
 )  
 
 (setq div1 (/ dist1 espac1))
 (setq div2 (1+ div1))
 (setq div3 (fix div2))
 (setq div4 (/ dist1 div3))
 (setq i 1)


 
   (repeat (1- div3)
     
    (entmake (list (cons 0 "INSERT")(cons 2 blkb)
                   (cons 10 (polar pt4 (angle pt4 pt5) (* div4 i)))
                   (cons 41 1)
                   (cons 42 1)
                   (cons 43 1)))
    (setq i (1+ i)))

 (parametrefin init)
 
 (prin1)
 
);fin

je suis pas trop sur comment appliquer le code que tu m'a fourni pour qu'il fonctionne.

(gile) · le 15 octobre 2012

Il manque un if dans :

    (progn
     
     (setq blkb "ALUMA")
     
     (not (tblsearch "BLOCK" blkb)
          (gc:ImportBlock "ALUMA" "cadre.dwt")
          
     )
     
   )

Il faut écrire :

    (progn
     (setq blkb "ALUMA")
     (if (not (tblsearch "BLOCK" blkb))
       (gc:ImportBlock "ALUMA" "cadre.dwt")
     )
   )

CadFrank · le 15 octobre 2012

Je l'ai essayer :(, Mais je vien de voir que j'avais pas bien placer une parenthèse ...

CadFrank · le 15 octobre 2012

Bon c'est bizarre.. ya plus rien qui se passe maintenant.. mon block apparait pas et la command arret.

CadFrank · le 15 octobre 2012

Je vien d'importer le block a partir de mon autre dessin et sa fonctionne.

Je crois que le program ne va pas chercher le block dans le fichier.

Est-ce que je dois avoir le fichier d'ouvert ?

mon emplacement pour les templates n'est pas a la meme place que celle fournie par autocad. j'ai modifier l'emplacement originale. Est-ce que cela pourrait causer problem.

(gile) · le 15 octobre 2012

L'avantage du LISP, c'est qu'il est très facile et rapide de tester des routines.

Dans un dessin vierge, ouvre l'éditeur Visual LISP.

Charge la routine gc:ImportBlock ainsi que les routines nécessaires à son fonctionnement (gc:GetAxDbDoc, gc:GetItem, DLLRegister, ProgID->ClassID, DBX-Register).

Dans la console de l'éditeur essaye l'expression que tu utilises dans ton code :

(gc:ImportBlock "ALUMA" "cadre.dwt")

Que retourne-t-elle ? T ou nil ?

Que disent les commentaires dans l'en-tête des routines gc:ImportBlock et gc:GetAxDbDoc ?

CadFrank · le 16 octobre 2012

Désolé, pour le délai. La réponse est nil.

Donc, si je lit bien les commentaire il na rien trouver.

Par contre, je vien de voir qu'il faut i inscrit le chemin du fichier dans gc:GetAxDbDoc. Mais je ne suis pas sur de ou dans se code je dois le placer. A moin que l'argument retourner ici est la celle du code. Donc ce code retourne le chemin pour le donner a gc:ImportBlock.

Est-ce que je me trompe?

Je vien aussi d'essayer de changer :

(gc:ImportBlock "ALUMA" "cadre.dwt")

par :

(gc:ImportBlock "ALUMA" "L:\TECHNIQUE (L2)\TEMPLATE\cadre.dwt")

Aucun changement tourjour nil.

(gile) · le 16 octobre 2012

En LISP la barre oblique inversée (antislash : \) est un caractère d'échappement utilisé pour les caractères spéciaux dans les chaînes ainsi que pour les guillemets et l'antislash lui même.

Il faut donc doubles les antislashes dans les chaînes décrivant un chemin de fichier.

(gc:ImportBlock "ALUMA" "L:\\TECHNIQUE (L2)\\TEMPLATE\\cadre.dwt")

Il semble qu'il te manque pas mal de fondamentaux en LISP pour t'atteler à une tache telle que celle que tu t'es fixée...

CadFrank · le 16 octobre 2012

Il semble qu'il te manque pas mal de fondamentaux en LISP pour t'atteler à une tache telle que celle que tu t'es fixée...

En effet, ce que je trouve domage c'est que je ne sais pas trop quoi faire comme petit program pour m'aider. Je n'est que eu un cour pour de l'introduction en lisp.

les codes que tu ma fournie sont bien complexe pour ma mon degrée de lispeur mais je veux apprend si tu as des sites ou des livres a me reférer je suis prenant :D

Le domaine dans lequel je travail n'a pas de porte facile hehe!

Bon sur ce je vais faire les modifications.

Merci !

CadFrank · le 16 octobre 2012

C'est magic sa fonctionne !!!!!

CadFrank · le 16 octobre 2012

J'était entrein de faire de la rechercher et je suis tomber sur une de tes anciens poste

offre tu en se moment des cours ?

Connexion

Alles chercher un block dans un template.

Messages recommandés

CadFrank

(gile)

CadFrank

(gile)

Patrick_35

(gile)

CadFrank

(gile)

CadFrank

CadFrank

(gile)

pierrevigneux

CadFrank

CadFrank

CadFrank

(gile)

CadFrank

CadFrank

CadFrank

(gile)

CadFrank

(gile)

CadFrank

CadFrank

CadFrank

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante