modif lips

[Big666]

Bonjour

 

Je suis toujours aussi doué avec Monsieur lisp.

 

J’ai essayé de modifier un lisp de gille chanteau, qui récupère les surfaces et périmètre d’unepolyl-igne fait de-même avec ça boite DCL et renommée GetnamC que j’ai modifié aussi bien sûr J’ai créé un bloc SFC.

 

Mais rien ne se passe .

 

lisp sfc :

 

;;; SFC -Gilles Chanteau- 13/04/07

;;; Insère le bloc "SFC" après sélection d'une polyligne

;;; Attribut 1 : Nom de la pièce

;;; j'ai ajouté un préfixe et un suffixe Surface et m² grâce a vous pascal lapostre

;;; Attribut 2 : Longueur de la polyligne

;;; Attribut 3 : Aire de la polyligne

 

(defun c:SFC (/ AcDoc Space bloc nom ent obj ins op reg ech id long aire ref)

(vl-load-com)

(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))

Space (if (= (getvar "CVPORT") 1)

(vla-get-PaperSpace AcDoc)

(vla-get-ModelSpace AcDoc)

)

)

(if (or (tblsearch "BLOCK" (setq bloc "SFC")) (findfile (setq bloc "SFC.dwg")))

(progn ;; attribut "nom de la pièce"

(if (not (setq nom (GetNameC "Nom de la pièce")))

(setq nom "")

)

(while (not (setq ent (car (entsel)))))

(setq obj (vlax-ename->vla-object ent))

(if (= "AcDbPolyline" (vla-get-ObjectName obj))

(progn (if (not (setq ins (getpoint "\nSpécifiez le point d'insertion ou < Centre >: ")))

(progn (if (= (vla-get-closed obj) :vlax-false)

(progn (vla-put-closed obj :vlax-true) (setq op T))

)

(setq reg (vlax-invoke space 'addRegion (list obj))

ins (vlax-get (car reg) 'Centroid)

)

(if op

(vla-put-closed obj :vlax-false)

)

(vla-delete (car reg))

)

)

(if (not (vlax-ldata-get "SFC" "ech"))

(vlax-ldata-put "SFC" "ech" 3)

)

(if (not

(setq ech (getreal (strcat "\nEntrez le facteur d'échelle <" (rtos (vlax-ldata-get "SFC" "ech")) ">: ")))

)

(setq ech (vlax-ldata-get "SFC" "ech"))

(vlax-ldata-put "SFC" "ech" ech)

)

 

(setq id (vla-get-ObjectID obj)

;; Attribut périmètre (mm² -> m²)

;;; j'ai ajouté un prefix et un suffix Surface et m² pascal lapostre

aire

(strcat "Surface: "

"%<\\AcObjProp Object(%<\\_ObjId "

(itoa id)

">%).Area \\f \"%lu2%pr2%ct8[1e-0]\">%"

" m²"

)

 

;; Attribut surface (mm -> m)

;;; j'ai ajouté un prefix et un suffix perimetre et ml pascal lapostre

long

(strcat "Périmètre: "

"%<\\AcObjProp Object(%<\\_ObjId "

(itoa id)

">%).Length \\f \"%lu2%pr2%ct8[1.00]\">%"

" ml"

)

)

(setq ref (vla-InsertBlock

Space

(vlax-3d-point (trans ins 1 0))

bloc

ech

ech

1

(angle '(0 0 0) (trans (getvar 'ucsxdir) 0 (trans '(0 0 1) 1 0 T)))

)

)

;; attribution de leur valeur aux attributs

(mapcar '(lambda (x y) (vla-put-TextString x y))

(vlax-invoke ref 'GetAttributes)

(list nom aire long)

)

(vla-regen AcDoc acActiveViewport)

)

(alert "L'objet sélectionné n'est pas une polyligne.")

)

)

(alert "Le bloc \"SFC\" est introuvable.")

)

(princ)

)

 

 

 

 

 

dcl :

 

;;; SFC -Gilles Chanteau- 13/04/07

;;; Insère le bloc "SFC" après sélection d'une polyligne

;;; Attribut 1 : Nom de la pièce

;;; j'ai ajouté un préfix et un sufix Surface et m² grace a vous pascal lapostre

;;; Attribut 2 : Longueur de la polyligne

;;; Attribut 3 : Aire de la polyligne

 

(defun c:SFC (/ AcDoc Space bloc nom ent obj ins op reg ech id long aire ref)

(vl-load-com)

(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))

Space (if (= (getvar "CVPORT") 1)

(vla-get-PaperSpace AcDoc)

(vla-get-ModelSpace AcDoc)

)

)

(if (or (tblsearch "BLOCK" (setq bloc "SFC")) (findfile (setq bloc "SFC.dwg")))

(progn ;; attribut "nom de la pièce"

(if (not (setq nom (GetNameC "Nom de la pièce")))

(setq nom "")

)

(while (not (setq ent (car (entsel)))))

(setq obj (vlax-ename->vla-object ent))

(if (= "AcDbPolyline" (vla-get-ObjectName obj))

(progn (if (not (setq ins (getpoint "\nSpécifiez le point d'insertion ou < Centre >: ")))

(progn (if (= (vla-get-closed obj) :vlax-false)

(progn (vla-put-closed obj :vlax-true) (setq op T))

)

(setq reg (vlax-invoke space 'addRegion (list obj))

ins (vlax-get (car reg) 'Centroid)

)

(if op

(vla-put-closed obj :vlax-false)

)

(vla-delete (car reg))

)

)

(if (not (vlax-ldata-get "SFC" "ech"))

(vlax-ldata-put "SFC" "ech" 3)

)

(if (not

(setq ech (getreal (strcat "\nEntrez le facteur d'échelle <" (rtos (vlax-ldata-get "SFC" "ech")) ">: ")))

)

(setq ech (vlax-ldata-get "SFC" "ech"))

(vlax-ldata-put "SFC" "ech" ech)

)

 

(setq id (vla-get-ObjectID obj)

;; Attribut périmètre (mm² -> m²)

;;; j'ai ajouté un prefix et un suffix Surface et m² pascal lapostre

aire

(strcat "Surface: "

"%<\\AcObjProp Object(%<\\_ObjId "

(itoa id)

">%).Area \\f \"%lu2%pr2%ct8[1e-0]\">%"

" m²"

)

 

;; Attribut surface (mm -> m)

;;; j'ai ajouté un prefix et un suffix perimetre et ml pascal lapostre

long

(strcat "Périmètre: "

"%<\\AcObjProp Object(%<\\_ObjId "

(itoa id)

">%).Length \\f \"%lu2%pr2%ct8[1.00]\">%"

" ml"

)

)

(setq ref (vla-InsertBlock

Space

(vlax-3d-point (trans ins 1 0))

bloc

ech

ech

1

(angle '(0 0 0) (trans (getvar 'ucsxdir) 0 (trans '(0 0 1) 1 0 T)))

)

)

;; attribution de leur valeur aux attributs

(mapcar '(lambda (x y) (vla-put-TextString x y))

(vlax-invoke ref 'GetAttributes)

(list nom aire long)

)

(vla-regen AcDoc acActiveViewport)

)

(alert "L'objet sélectionné n'est pas une polyligne.")

)

)

(alert "Le bloc \"SFC\" est introuvable.")

)

(princ)

)