vla-addLightWeightPolyline

zebulon_ · le 5 octobre 2007

Bonjour,

le sujet c'est de créer, avec VLISP, une nouvelle lwpolyline. J'ai eu un peu de mal avec les safearray et sur le fait qu'il ne faut pas de coordonnées z dans les points à transmettre à vla-addLightWeightPolyline.

Je livre à votre critique un petit exercice qui dessine une polyligne de "reprise de bétonnage" entre 2 points saisis par l'utilisateur et qui utilise vla-addLightWeightPolyline.

(defun cs:LwPolyline (LISTPT LARGEUR / ACDOC SPACE TABLEAU MyLwPolyline)
 (setq LISTPT (mapcar '(lambda (x) (list (car x) (cadr x))) LISTPT)) ;; enlever les z pour la lwpolyline
 (setq ACDOC (vla-get-activedocument (vlax-get-acad-object)))
 (setq SPACE
   (if (= (getvar "CVPORT") 1)
     (vla-get-PaperSpace ACDOC)
     (vla-get-ModelSpace ACDOC)
   )
 )
 ;; "transformer" les points en atomes avec append
 (setq LISTPT (apply 'append LISTPT))
 ;; créer le tableau
 (setq TABLEAU
   (vlax-make-safearray
     vlax-vbDouble
     (cons 0 (- (length LISTPT) 1))
   )
 )
 ;; remplir le tableau
 (vlax-safearray-fill TABLEAU LISTPT)
 ;; créer la polyline
 (setq MyLwPolyline (vla-addLightWeightPolyline SPACE TABLEAU))
 ;; lui coller une épaisseur
 (vla-put-ConstantWidth MyLwPolyline LARGEUR)
 MyLwPolyline
)


(defun cs:startundomark ()
 (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
)

(defun cs:endundomark ()
 (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
)


(defun C:RB ( / PT1 PT2 ANG L H DEP LISTPT P2 P3 P4)
 (cs:startundomark)
 (if (not RB_DIST)
   (cond
     ((= (getvar "INSUNITS") 4) (setq RB_DIST 50.0))     ;; mm
     ((= (getvar "INSUNITS") 5) (setq RB_DIST 5.0))      ;; cm
     ((= (getvar "INSUNITS") 14) (setq RB_DIST 0.5))     ;; dm
     ((= (getvar "INSUNITS") 6) (setq RB_DIST 0.05))     ;; m
     (T (setq RB_DIST 0.05))
   )
 )

 (setq PT1 nil)
 (prompt (strcat "\nEspace entre les symboles de reprise : " (rtos RB_DIST 2 3)))

 (while (/= (type PT1) 'LIST)
   (initget 1 "Espace")
   (setq PT1 (getpoint "\nPremier point ou [Espace] : "))
   (cond
     ((= PT1 "Espace")
       (setq RB_DIST (getdist "\nEspace entre les symboles de reprise : "))
     )
   )
 )
 (setq PT2 (getpoint PT1 "\nDeuxième point : "))
 (setq ANG (angle PT1 PT2))
 (setq L (distance PT1 PT2))
 (setq H (/ RB_DIST 2))

 (setq DEP 0)
 (setq LISTPT (list PT1))
 (while (< (+ DEP RB_DIST H) L)
   (setq P2 (polar PT1 ANG RB_DIST))
   (setq LISTPT (cons P2 LISTPT))
   (setq P3 (polar P2 (+ ANG (atan 2)) (sqrt (/ (* 5 H H) 16))))
   (setq LISTPT (cons P3 LISTPT))
   (setq P4 (polar P3 (- ANG (atan 2)) (sqrt (/ (* 5 H H) 4))))
   (setq LISTPT (cons P4 LISTPT))
   (setq PT1 (polar P4 (+ ANG (atan 2)) (sqrt (/ (* 5 H H) 16))))
   (setq LISTPT (cons PT1 LISTPT))
   (setq DEP (+ DEP RB_DIST H))
 )
 (setq LISTPT (cons PT2 LISTPT))
 (setq LISTPT (reverse LISTPT))
 (setq LISTPT (mapcar '(lambda (x) (trans x 1 0)) LISTPT)) ;; coordonnées SCG

 (cs:LwPolyline LISTPT 0)
 (cs:endundomark)
 (princ)
)

Amicalement

Zebulon_

lili2006 · le 5 octobre 2007

Bonjour à toutes et tous,

Chez moi, ça marche MAIS l'unité utilisé en BE BA étant le cm, l'intervale des cassures et (pour moi, tout du moins !) trop rapproché. Il faudrait pouvoir en avoir qu'une tous les 20 cm . Est-ce possible ?

zebulon_ · le 5 octobre 2007

MAIS l'unité utilisé en BE BA étant le cm

Cela fait 20 ans que je roule ma bosse dans les BE BA et il y a de tout. J'en connais qui travaillent en cm, d'autres en m et même un qui travaille en mm. Moi, je trouve que le plus "naturel" est de travailler en m, mais c'est une appréciation toute personnelle.

l'intervale des cassures et (pour moi, tout du moins !) trop rapproché

le lisp regarde quelle est l'unité de travail du fichier. Si c'est le cm, la distance par défaut entre 2 cassures sera de 5 cm et la cassure fera 2.5x2.5 cm. Si cela ne convient pas, tu peux taper la lettre E au moment où le lisp t'invite à saisir le premier point et tu pourras saisir une autre distance entre 2 cassures, par exemple 20cm. Et la cassure fera 10x10.

Amicalement

Zebulon_

[Edité le 5/10/2007 par zebulon_]

lili2006 · le 5 octobre 2007

Re,

Terrible, zebulon_. Tu avait pensé à tout. Excuse mon ignorance, ou plutôt ma mauvaise habitude de ne plus regarder la ligne de commande (je l'ai mise en palette en cas de besoins, c'est à dire 1% de mon temps).

Je trouve cette routine trés pratique et te remercie de la partager ici.

Bonne continuation.

(gile) · le 5 octobre 2007

Salut,

Pour éviter de faire un "safearay" puis un "variant", tu peux utiliser la fonction vla-invoke qui accepte des listes (voir ce sujet)

Exemple avec plst = liste de points et space = pointeur vers l'espace courant :

(vlax-invoke
 Space
 'addLightweightPolyline
 (apply 'append
 (mapcar
   '(lambda (x)
      (list (car x) (cadr x))
    )
   plst
 )
 )
)

Bred · le 5 octobre 2007

Salut zebulon_,

J'avoue ne pas connaitre cette manière de créer des sous-routine avec un (defun cs:maroutine ()

Surtout que tu es obligé pour l'appeller de d'écrire un (cs:maroutine ....)

Pour gagner un peu de temps, assemble tes (setq

(setq PT2 (getpoint PT1 "\nDeuxième point : ")
ANG (angle PT1 PT2)
L (distance PT1 PT2)
(setq H (/ RB_DIST 2))

... mais j'avoue que je l'ai testé, et chez moi ça ne fonctionne pas....

je pense qu'il y a un problème dans ta demande du pt1 : si on donne l'espace, tu ne le remandes pas.

(gile) · le 5 octobre 2007

J'avoue ne pas connaitre cette manière de créer des sous-routine avec un (defun cs:maroutine ()
Surtout que tu es obligé pour l'appeller de d'écrire un (cs:maroutine ....)

C'est le "cs:" qui te perturbe ?

Celà revient au même que si tu utilisais (defun maroutine () ...) ou (defun bred:maroutine () ...) quand tu l'appelle tu fais bien (maroutine ..) ou (bred:maroutine ...).

Mettre un préfixe à ses routines est une bonne chose (que je devrais faire d'ailleurs), c'est une manière de les "signer" pour éviter avec d'autres suceptibles d'avoir le même nom.

lili2006 · le 5 octobre 2007

Re,

... mais j'avoue que je l'ai testé, et chez moi ça ne fonctionne pas....

.

Il faut saisir "E" avant même d'avoir selectionné le 1er point (pratique si tu as les commandes dyn sur la souris : F12).

zebulon_ · le 5 octobre 2007

Pour gagner un peu de temps, assemble tes (setq

c'est quelque chose que je ne fais jamais (ou rarement), parce que je préfère que chaque affectation de variable soit isolée des autres. Comme ça, quand je dois faire un copier/coller d'une partie de mon lisp pour m'en resservir ailleurs, je ne risque pas de couper au milieu d'un (setq ...)

Une question de gout... ;)

C'est le "cs:" qui te perturbe ?

c'est effectivement une signature. Même si ça rallonge les noms de fonctions, cela diminue le risque d'avoir d'éventuels doublons.

Merci à (gile) pour le vlax-invoke. Non, finalement, pas merci. Parce que je me suis cassé la tête à essayer de comprendre les safearray et tu m'annonces froidement que je me suis cassé la tête pour rien...Pff... ;)

Je trouve cette routine très pratique et te remercie de la partager ici.

lili2006, entre bétonneux, faut bien s'entraider, non ?

Amicalement

Zebulon_

Bred · le 5 octobre 2007

C'est le "cs:" qui te perturbe ?

Ben oui... mais j'suis bête je n'avais pas compris ça comme ça : vu qu'il y avait un c dedans, je pensais qu c'était un appel de defun différent...

Mettre un préfixe à ses routines est une bonne chose (que je devrais faire d'ailleurs), c'est une manière de les "signer" pour éviter avec d'autres suceptibles d'avoir le même nom.

En fait je le fait, aussi bien pour les routines que pour les commandes.

Pour les commandes, la raison en est que si j'en cherche une, je rentre l'intro puis le fait Tab, elle ressortiras à un moment....

Il faut saisir "E" avant même d'avoir selectionné le 1er point (pratique si tu as les commandes dyn sur la souris : F12).

Ok, vu.

Pour les setq, c'est en effet une question de gout... et de rapidité déxécution.

Moins il y en a d'écris, plus vite ça va.

Et pour finir, je ne vais être pas sympa : je verrais bien un centrage des cassures entre les deux points (si la norme le permet)

Et si le trait est trop petit pour dessinner la cassure, divisiser l'ecart automatiquement... ;) ;)

lili2006 · le 5 octobre 2007

Re,

lili2006, entre bétonneux, faut bien s'entraider, non ?

Absolument, surtout qu'au niveau des progiciels, on est pas trés aidé,...

je verrais bien un centrage des cassures entre les deux points (si la norme le permet)
Et si le trait est trop petit pour dessinner la cassure, divisiser l'ecart automatiquement

Le top du top !

merci en tous cas. C'est déjà fameux comme ça.

zebulon_ · le 5 octobre 2007

je verrais bien un centrage des cassures entre les deux points (si la norme le permet)

Je ne sais pas si c'est normalisé ?

Ce qui est marrant, c'est que j'ai publié ce lisp pour avoir votre avis sur le vla-addLightMachinTruc et la plupart me parlent de l'application qui ne devait que l'illustrer ;)

Mais si ça peut être utile, tant mieux ! Moi ça fait 15 ans que je m'en sers et, à l'époque j'avais créé la polyligne (et oui, il n'y avais pas encore de lwpolyline) avec entmake...

Cela ressemblait à ça :

 (defun C:RB ()
 (setq OLD_CMD (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setq OLDOS (getvar "osmode"))
 (setvar "osmode" 0)
 (command "_UNDO" "_m")
 (initget 1)
 (setq PT1 (getpoint "\nPremier point :"))
 (initget 1)
 (setq PT2 (getpoint "\nDeuxième point :"))
 (initget 1)
 (setq D (getdist "\nEspace entre les symboles de reprise :"))
 (setq H (/ D 2))
 (command "_LINE" PT1 PT2 "")
 (setq E (entlast))
 (command "_UCS" "_E" E)
 (entdel E)
 (setq L (distance PT1 PT2))
 (setq DEP 0)
 (entmake '( (0 . "POLYLINE")))
 (while (< (+ DEP D H) L)
   (entmake (list (cons 0 "VERTEX") (cons 10 (trans (list DEP 0 0) 1 0))))
   (entmake (list (cons 0 "VERTEX") (cons 10 (trans (list (+ DEP D) 0 0) 1 0))))
   (entmake (list (cons 0 "VERTEX") (cons 10 (trans (list (+ DEP D (* H 0.25)) (/ H 2) 0) 1 0))))
   (entmake (list (cons 0 "VERTEX") (cons 10 (trans (list (+ DEP D (* H 0.75)) (/ H -2) 0) 1 0))))
   (entmake (list (cons 0 "VERTEX") (cons 10 (trans (list (+ DEP D H) 0 0) 1 0))))
   (setq DEP (+ DEP D H))
 )
 (entmake (list (cons 0 "VERTEX") (cons 10 (trans (list L 0 0) 1 0))))
 (entmake '( (0 . "SEQEND")))
 (command "_UCS" "_P")
 (setvar "osmode" OLDOS)
 (setvar "cmdecho" OLD_CMD)
)

et ça marchait bien aussi.

Amicalement

Zebulon_

lili2006 · le 5 octobre 2007

Rerere,

et ça marchait bien aussi.

En effet !

j'ai publié ce lisp pour avoir votre avis sur le vla-addLightMachinTruc

Désolé, c'est du chinois pour moi,....

Bred · le 5 octobre 2007

Ce qui est marrant, c'est que j'ai publié ce lisp pour avoir votre avis sur le vla-addLightMachinTruc et la plupart me parlent de l'application qui ne devait que l'illustrer

C'est qu'il n'y a rien à dire !

C'est parfait !

Juste un détail pratique personnel :

Ceci :

(setq ACDOC (vla-get-activedocument (vlax-get-acad-object)))
(setq SPACE
(if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace ACDOC)
(vla-get-ModelSpace ACDOC)
)
)

est peut-être astucieux d'en créer un routine : tu n'auras qu'a l'appeller dans tes routines Undo, et tu en auras besoin dans d'autre !....

(gile) · le 5 octobre 2007

Merci à (gile) pour le vlax-invoke. Non, finalement, pas merci. Parce que je me suis cassé la tête à essayer de comprendre les safearray et tu m'annonces froidement que je me suis cassé la tête pour rien...Pff... ;)

Tu n'est pas le seul, les variants et autre safearray m'on vraiment rebuté quand j'ai commencé à me mettre au Visual LISP. C'est BTO qui m'a enlevé cette épine du pied, et depuis à coups de vlax-get, vlax-put, vlax-invoke c'est beaucoup moins rébarbatif.

Par exemple, juste une petite routine pour "partionner" les listes de points retournées par (vlax-get obj 'Coordinates) qui sont des flat lists comme celles passée à vlax-SafeArray-fill.

- la première pour les lwpolylines la seconde pour les poly 2d ou 3d, les splines etc..

;;; 2d-coord->pt-lst Convertit une liste de coordonnées 2D en liste de points 2D
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0))

(defun 2d-coord->pt-lst	(lst)
 (if lst
   (cons (list (car lst) (cadr lst))
  (2d-coord->pt-lst (cddr lst))
   )
 )
)

;;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points
;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))

(defun 3d-coord->pt-lst	(lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
  (3d-coord->pt-lst (cdddr lst))
   )
 )
)

(setq plst (2d-coord->pt-lst (vlax-get obj 'Coordinates)))

et on se retrouve avec une liste des coordonnées de la polyligne, liste de points classique comme on en a l'habitude, qu'on peut modifier (déplacer ajouter, supprimer des sommets), puis on ré-injecte avec un :

(vlax-put obj 'coordinates (apply 'append plst))

qui suffit à modifier la poly.[Edité le 5/10/2007 par (gile)]

[Edité le 7/10/2007 par (gile)]

zebulon_ · le 5 octobre 2007

J'ai un problème d'affichage sur ta réponse (gile), ça me fait une grosse tâche noire.

Maintenant, je n'ai plus de problème d'affichage, mais de compréhension. Ou alors il manque un bout, ou ça me dépasse.

[Edité le 5/10/2007 par zebulon_]

(gile) · le 5 octobre 2007

Maintenant, je n'ai plus de problème d'affichage, mais de compréhension. Ou alors il manque un bout, ou ça me dépasse.

En réparant j'ai du effacer des bouts :calim:

J'ai corrigé.

Il s'agit juste d'un exemple avec les fonction vlax-...

Connexion

vla-addLightWeightPolyline

Messages recommandés

zebulon_

lili2006

zebulon_

lili2006

(gile)

Bred

(gile)

lili2006

zebulon_

Bred

lili2006

zebulon_

lili2006

Bred

(gile)

zebulon_

(gile)

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante