Aller au contenu

erreur: no function definition: POINTTOVARIANT


zozo

Messages recommandés

Salut tous le monde,

 

J'ai récupéré un lisp sur ce site qui me permet de créer un tableau de métré linéaire par calque.

Ce lisp marche très bien mais quand je change d'ordi,j'ai ce message d'erreur qui apaprait :

erreur: no function definition: POINTTOVARIANT

Pourriez-vous m'aider à trouver la solution.

 

Je vous met ci-joint le programme :

(defun c:metre (

/ acadObject ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName 

  LineWeight ModelSpace n NumColumns NumRows objectName perimeter Point2D Resultat Resultats row RowHeight 

  tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau

  )
(setvar "clayer" "0")

  (setq filteredLayers "*")  

  (setq filteredObjets "*line")  


  ;; Taille du tableau

  (setq textsize (getvar "textsize"))         

  (setq RowHeight (* 2.0 textsize))

  (setq ColWidth (* 10.0 RowHeight))           
  (setq LineWeight acLnWt040)                 



  (setq filteredLayers (strcase filteredLayers t))  

  (setq filteredObjets (strcase filteredObjets t))  



  (setq acadObject (vlax-get-acad-object))

  (setq ThisDrawing (vla-get-ActiveDocument acadObject))

  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))

  (setq vlaLayers (vla-get-Layers ThisDrawing))

  (setq LayerCount (vla-get-count vlaLayers))


  (setq Point2D (getpoint "\nPoint d'insertion: "))

  (setq vlaPoint3D (PointToVariant Point2D))

  (setq NumRows (+ 3 LayerCount)) 

  (setq NumColumns 2)


  (setq Resultats nil)

  (setq layerNames nil)

  (vlax-for vlaLayer vlaLayers

     (setq layerName (vla-get-name vlaLayer))

     (setq lcLayerName (strcase layerName t))  

     (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames)))

  )

  (setq layerNames (vl-sort layerNames '<))  ; Trier en ordre croissant

  (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames))


  (vlax-for vlaObject ModelSpace

     

     (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets)

              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)

         )

     (progn

        (setq endPt (vlax-curve-getEndParam vlaObject))

        (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt))

        (setq Total (+ perimeter (cdr (assoc layerName Resultats))))

        (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) 

     ))

  )



  (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))

  (vla-SetCellAlignment vlaTableau 0 0 acMiddleCenter)

  (vla-SetCellTextHeight vlaTableau 0 0 textsize)

  (vla-SetCellValue vlaTableau 0 0 "Résultats")




  (vla-SetCellGridLineWeight vlaTableau 1 0 4 LineWeight)

  (vla-SetCellAlignment vlaTableau 1 0 acMiddleCenter)

  (vla-SetCellTextHeight vlaTableau 1 0 textsize)

  (vla-SetCellValue vlaTableau 1 0 "Calques")



  (vla-SetCellGridLineWeight vlaTableau 1 1 4 LineWeight)

  (vla-SetCellAlignment vlaTableau 1 1 acMiddleCenter)

  (vla-SetCellTextHeight vlaTableau 1 1 textsize)

  (vla-SetCellValue vlaTableau 1 1 "Périmètres")




  (setq i 0)

  (setq n LayerCount)

  (setq Total 0.0)

  (while (< i n)

     (setq Resultat (nth i Resultats))

     (setq row (+ i 2))


     ;; Calque

     (setq layerName (strcase (car Resultat)))

     (vla-SetCellAlignment vlaTableau row 0 acMiddleLeft)

     (vla-SetCellTextHeight vlaTableau row 0 textsize)

     (vla-SetCellValue vlaTableau row 0 layerName)


     ;; Périmètre

     (setq perimeter (cdr Resultat))

     (setq Total (+ Total perimeter))

     (vla-SetCellAlignment vlaTableau row 1 acMiddleRight)

     (vla-SetCellTextHeight vlaTableau row 1 textsize)

     (vla-SetCellValue vlaTableau row 1 (rtos perimeter))

     (setq i (1+ i))

  ) 


  ;; Total

  (setq row (+ LayerCount 2))

  (setq layerName "Total")

  (vla-SetCellGridLineWeight vlaTableau row 0 1 LineWeight)

  (vla-SetCellAlignment vlaTableau row 0 acMiddleLeft)

  (vla-SetCellTextHeight vlaTableau row 0 textsize)

  (vla-SetCellValue vlaTableau row 0 layerName)


  ;; Périmètre total

  (setq perimeter Total)

  (setq Total (+ Total perimeter))

  (vla-SetCellGridLineWeight vlaTableau row 1 1 LineWeight)

  (vla-SetCellAlignment vlaTableau row 1 acMiddleRight)

  (vla-SetCellTextHeight vlaTableau row 1 textsize)

  (vla-SetCellValue vlaTableau row 1 (rtos perimeter))

)

 

En vous remerciant par avance. ;) ;)

Lien vers le commentaire
Partager sur d’autres sites

Salut

 

Il te manque la fonction PointToVariant qui est appelée dans cette ligne

(setq vlaPoint3D (PointToVariant Point2D))

 

Normalement, ce devrait être quelque chose comme ceci

(defun PointToVariant(pts)
 (vlax-3d-point pts)

 

Ou tout simplement, en remplacant

(setq vlaPoint3D (PointToVariant Point2D))

par

(setq vlaPoint3D (vlax-3d-point Point2D))

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites

Salut

 

Il te manque la fonction PointToVariant qui est appelée dans cette ligne

(setq vlaPoint3D (PointToVariant Point2D))

 

Normalement, ce devrait être quelque chose comme ceci

(defun PointToVariant(pts)
 (vlax-3d-point pts)

 

Ou tout simplement, en remplacant

(setq vlaPoint3D (PointToVariant Point2D))

par

(setq vlaPoint3D (vlax-3d-point Point2D))

 

@+

 

Salut Patrick,

 

je te remercie de m'avoir répondu.

Cependant en rajoutant la fonction defun avec ce qui suit dans le lisp , j'ai cette erreur qui apparait :

; erreur: no function definition: VLAX-GET-ACAD-OBJECT

et en essayant de remplacer ce que tu m'as dit j'ai la même erreur.

Lorsque je la supprime et que je revient à l'état initial du programme , cette même erreur revient et l'erreur sur le PointToVariant n'apparait plus. Bizarre :( ...

Lien vers le commentaire
Partager sur d’autres sites

Salut.

 

Peut-être avec ça en début de Lisp :

(vl-load-com)

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

Lien vers le commentaire
Partager sur d’autres sites

Salut.

 

Peut-être avec ça en début de Lisp :

(vl-load-com)

 

 

En insérant les deux commandes dans le lisp cela fonctionne très bien, je vous en remercie , vous m'enlevez une épine du pied :(rires forts): .

 

Bonne fin de journée ;)

Lien vers le commentaire
Partager sur d’autres sites

J'en connais un qui dirait : "Une épine, une bière"... :P

 

Content d'avoir aidé... ;)

  • Upvote 1

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

Lien vers le commentaire
Partager sur d’autres sites

Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité