erreur: no function definition: POINTTOVARIANT

[zozo]

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. ;) ;)

[Patrick_35]

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))

 

@+

[zozo]

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 :( ...

[DenisHen]

Salut.

 

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

(vl-load-com)

[zozo]

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 ;)

[DenisHen]

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

 

Content d'avoir aidé... ;)