CADxp: modif lips - CADxp

Aller au contenu

Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

modif lips

#1 L'utilisateur est hors-ligne   big666 

  • ceinture noire 1er dan
  • Groupe : Membres
  • Messages : 705
  • Inscrit(e) : 04-septembre 08

Posté 16 avril 2019 - 14:53

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















notre mascotte


Nous vivons tous dans le ventre d'un chien géant
Tout le monde le sait mais personne ne dit rien du tout

ultra Vomit
0

Partager ce sujet :


Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)