Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Question plus simple!

Magdi95

Par Magdi95
dans Routines LISP

 Partager

Messages recommandés

Magdi95 Newbie

Magdi95

Posté(e)
Posté(e)

Bonjour à tous,

Mon dernier poste concernant la modification du lisp DS2 devait faire peur alors qu'il y a surement plus simple avec le lisp MES de Patrick, enfin je l'espere!

 

Voici ce que je souhaiterais pouvoir faire: MES permet de mesurer des distances d'un point à un autre et de les cumuler, est il possible de proposer d'appliquer cette distance cumulé a un attribut sans pour autant perdre le fil càd d'appliquer cette valeur a un attribut quand je le souhaite?

 

Ci joint le code MES:

 

 (defun c:mes (/ pt1 pt2 tot)
(setq tot 0)
(if (setq pt1 (getpoint "\nPremier point : "))
(while (setq pt2 (getpoint pt1 "\nPoint suivant : "))
(setq tot (+ tot (distance pt1 pt2)))
(princ (strcat "\n Distance cumulée : " (rtos tot) " --> Distance mesurée : " (rtos (distance pt1 pt2))))
(setq pt1 pt2)
)
)
(princ)
)

 

Si ma demande n'est pas realisable merci de m'en faire part je comprendrais

 

Bonne journée à toute la comunauté :D

Magdi

 

Patrick_35 Newbie

Patrick_35

Posté(e)
Posté(e)

Salut

 

(defun c:mea (/ att pt1 pt2 tot)
 (setq tot 0)
 (and	(setq att (nentsel "\nSélectionnez un attribut : "))
(setq att (entget (car att)))
(eq (cdr (assoc 0 att)) "ATTRIB")
(setq pt1 (getpoint "\nPremier point : "))
   (while (setq pt2 (getpoint pt1 "\nPoint suivant : "))
     (setq tot (+ tot (distance pt1 pt2)))
     (princ (strcat "\n Distance cumulée : " (rtos tot) " --> Distance mesurée : " (rtos (distance pt1 pt2))))
     (entmod (setq att (subst (cons 1 (rtos tot)) (assoc 1 att) att)))
     (setq pt1 pt2)
   )
 )
 (princ)
)

 

@+

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

Magdi95 Newbie

Magdi95

Posté(e)
  • Auteur
Posté(e)

Re,

Merci d'avoir pris le temps. Le resultat n'est pas tout à fait ce que j'attend!

Le principe de départ est identique à celui de MES:

 

- pouvoir selectionner plusieurs points (qui correspondent au chemin qu'emprunte mon cable) en cumulant les longueurs entre chaque point.

-Puis pouvoir à tous moments renseigner la distance cumulée à un attribut (de mon premier poste informatique)

-Pouvoir continuer ma selection de point s puis à nouveau renseigner la distance cumulé depuis le debut a un nouvel attribut (mon second poste de travail).

-Puis continuer juqu'a mon prochain attribut etc...

 

J'espere avoir été assez clair sinon je peux poster un petit schéma de principe.

Merci d'avance

Magdi

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Salut,

 

Ce qui suit ?

Le code est tiré en grande partie de cette réponse et adapté rapidement...

 

(defun draw_pt (pt col / rap)
 (setq rap (/ (getvar "viewsize") 50))
 (foreach n
      (mapcar '(lambda (x)
     (list ((eval (car x)) (car pt) rap)
           ((eval (cadr x)) (cadr pt) rap)
     )
         )
        '((+ +) (+ -) (- +) (- -))
      )
   (grdraw (trans pt 0 1) (trans n 0 1) col)
 )
)
(defun make_blk_measure ( / )
   (if (not (tblsearch "STYLE" "$BLK_MEAS"))
     (entmake '((0 . "STYLE")
     (5 . "40")
     (100 . "AcDbSymbolTableRecord")
     (100 . "AcDbTextStyleTableRecord")
     (2 . "$BLK_MEAS")
     (70 . 0)
     (40 . 0.0)
     (41 . 1.0)
     (50 . 0.0)
     (71 . 0)
     (42 . 0.1)
     (3 . "ARIAL.TTF")
     (4 . "")
    )
     )
   )
   (if (not (tblsearch "BLOCK" "BLK_MEASURE_CURVE"))
     (progn
  (entmake
   '((0 . "BLOCK") (8 . "0") (2 . "BLK_MEASURE_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0))
 )
 (entmake
   (append
     '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine"))
     (list (list 10 0.0 (/ (- (getvar "TEXTSIZE")) 10.0) 0.0))
     (list (list 11 0.0 (/ (getvar "TEXTSIZE") 10.0) 0.0))
     '((210 0.0 0.0 1.0))
   )
  )
  (entmake
   '(
 (0 . "ATTDEF")
 (100 . "AcDbEntity")
 (67 . 0)
 (410 . "Model")
 (8 . "0")
 (62 . 0)
 (6 . "ByBlock")
 (370 . -2)
 (100 . "AcDbText")
 (10 0.5 0.05 0.0)
 (40 . 1.0)
 (1 . "0.0")
 (50 . 1.570796326794896)
 (41 . 1.0)
 (51 . 0.0)
 (7 . "$BLK_MEAS")
 (71 . 0)
 (72 . 0)
 (11 0.0 0.05 0.0)
 (210 0.0 0.0 1.0)
 (100 . "AcDbAttributeDefinition")
 (3 . "measure")
 (2 . "VALUE_MEASURE")
 (70 . 0)
 (73 . 2)
 (74 . 2)
   )
 )
 (entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2)))
     )
   )
)
(defun z_dir (p1 p2 / )
 (trans
   '(0.0 1.0 0.0)
   (mapcar
     '(lambda (k)
       (/ k
         (sqrt
           (apply '+
             (mapcar
               '(lambda (x) (* x x))
               (mapcar '- p2 p1)
             )
           )
         )
       )
     )
     (mapcar '- p2 p1)
   )
   0
 )
)
(defun c:multi-mesure ( / js nb dxf_obj obj_vlax pt_start pt_end total_dist ori_dist tmp_var sv_luprec sv_dzin ptx ang dxf_210)
 (princ "\nSélectionner les objets curvilignes à mesurer: ")
 (while
   (not
     (setq js
       (ssget
         (list
           (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE")
           (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
           (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
           (cons -4 "            (cons -4 "&") (cons 70 112)
           (cons -4 "NOT>")
         )
       )
     )
   )
   (princ "\nPas d'objets valable ou sélection vide!")
 )
 (setq nb -1)
 (vl-load-com)
 (repeat (sslength js)
   (setq
     dxf_obj (entget (ssname js (setq nb (1+ nb))))
     obj_vlax (vlax-ename->vla-object (ssname js nb))
     pt_start (vlax-curve-getStartPoint obj_vlax)
     pt_end (vlax-curve-getEndPoint obj_vlax)
     total_dist (vlax-curve-getDistAtParam obj_vlax (vlax-curve-getEndParam obj_vlax))
   )
   (redraw (cdar dxf_obj) 3)
   (draw_pt pt_start 3)
   (setq ori_dist (getreal "\nDémarrer l'origine à la valeur? <0.0>: "))
   (if (not ori_dist) (setq ori_dist 0.0))
   (initget 6)
   (setq tmp_var (getdist (strcat "Entrez une nouvelle valeur pour TEXTSIZE <" (rtos (getvar "TEXTSIZE")) ">: ")))
   (if (not tmp_var) (setq tmp_var (getvar "TEXTSIZE")))
   (setvar "TEXTSIZE" tmp_var)
   (make_blk_measure)
   (setq
     sv_luprec (getvar "LUPREC")
     sv_dzin (getvar "DIMZIN")
   )
   (setvar "CMDECHO" 1)
   (setvar "DIMZIN" 0)
   (command "_.luprec" 0)
   (while (setq ptx (getpoint "\nPoint à mesurer?: "))
     (setq
       ptx (vlax-curve-getClosestPointTo obj_vlax (trans ptx 1 0))
       ang (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj_vlax (vlax-curve-getParamAtPoint obj_vlax ptx)))
       dxf_210 (z_dir ptx (polar ptx ang (getvar "TEXTSIZE")))
     )
     (entmake
       (list
         (cons 0 "INSERT")
         (cons 100 "AcDbEntity")
         (assoc 67 dxf_obj)
         (assoc 410 dxf_obj)
         (cons 8 (getvar "CLAYER"))
         (cons 100 "AcDbBlockReference")
         (cons 66 1)
         (cons 2 "BLK_MEASURE_CURVE")
         (cons 10 (trans ptx 0 dxf_210))
         (cons 41 1.0)
         (cons 42 1.0)
         (cons 43 1.0)
         (cons 50 ang)
         (cons 210 dxf_210)
       )
     )
     (entmake
       (list
         (cons 0 "ATTRIB")
         (cons 100 "AcDbEntity")
         (assoc 67 dxf_obj)
         (assoc 410 dxf_obj)
         (cons 8 (getvar "CLAYER"))
         (cons 100 "AcDbText")
         (cons 10
           (polar
             (polar (trans ptx 0 dxf_210) (+ (/ pi 2) ang) (* 0.05 (getvar "TEXTSIZE")))
             ang
             (* 0.5 (getvar "TEXTSIZE"))
           )
         )
         (cons 40 (getvar "TEXTSIZE"))
         (cons 1 (rtos (vlax-curve-getDistAtPoint obj_vlax ptx) 2 2))
         (cons 50 (+ (/ pi 2) ang))
         (cons 41 1.0)
         (cons 51 0.0)
         (cons 7 "$BLK_MEAS")
         (cons 71 0)
         (cons 72 0)
         (cons 11 (polar (trans ptx 0 dxf_210) (+ (/ pi 2) ang) (* 0.05 (getvar "TEXTSIZE"))))
         (cons 210 dxf_210)
         (cons 100 "AcDbAttribute")
         (cons 2 "VALUE_MEASURE")
         (cons 70 0)
         (cons 73 2)
         (cons 74 2)
       )
     )
     (entmake (list (cons 0 "SEQEND") (cons 8 (getvar "CLAYER")) (cons 62 0) (cons 6 "ByBlock") (cons 370 -2)))
   )
   (setvar "LUPREC" sv_luprec)
   (setvar "DIMZIN" sv_dzin)
   (draw_pt pt_start -1)
   (redraw (cdar dxf_obj) 4)
 )
 (redraw)
 (prin1)
)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Patrick_35 Newbie

Patrick_35

Posté(e)
Posté(e)

Salut

 

(defun c:mea (/ att pt1 pt2 tot)
 (setq tot 0)
 (while (and	(setq att (nentsel "\nSélectionnez un attribut : "))
	(setq att (entget (car att)))
	(eq (cdr (assoc 0 att)) "ATTRIB")
	(if pt1 (setq pt2 pt1)(setq pt1 (getpoint "\nPremier point : ")))
   (while (setq pt2 (getpoint pt1 "\nPoint suivant : "))
     (setq tot (+ tot (distance pt1 pt2)))
     (princ (strcat "\n Distance cumulée : " (rtos tot) " --> Distance mesurée : " (rtos (distance pt1 pt2))))
     (entmod (setq att (subst (cons 1 (rtos tot)) (assoc 1 att) att)))
     (setq pt1 pt2)
          )
 )
 )
 (princ)
)

 

Utilisation

MEA

Sélectionnez un attribut :

Premier point :

Point suivant :

Distance cumulée : 7.5 --> Distance mesurée : 7.5

Point suivant :

Distance cumulée : 17.5 --> Distance mesurée : 10

Point suivant :

Distance cumulée : 27.5 --> Distance mesurée : 10

Point suivant :

Distance cumulée : 37.5 --> Distance mesurée : 10

Point suivant :

Distance cumulée : 76.31044 --> Distance mesurée : 38.81044

Point suivant :

 

Sélectionnez un attribut :

Point suivant :

Distance cumulée : 92.31825 --> Distance mesurée : 16.00781

Point suivant :

Distance cumulée : 104.81825 --> Distance mesurée : 12.5

Point suivant :

Distance cumulée : 115.12601 --> Distance mesurée : 10.30776

Point suivant :

 

Sélectionnez un attribut :

Point suivant :

Distance cumulée : 136.48602 --> Distance mesurée : 21.36001

Point suivant :

Distance cumulée : 154.16369 --> Distance mesurée : 17.67767

Point suivant :

Distance cumulée : 184.16369 --> Distance mesurée : 30

Point suivant :

 

Sélectionnez un attribut :

 

 

Commande:

 

@+

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

Magdi95 Newbie

Magdi95

Posté(e)
  • Auteur
Posté(e)

Salut,salut

Merci pour vos réponses. La modif de MEA répond bien a ma demande Patrick s'est parfait.

Petit souci d'explication de ma part :cool: :exclam: au debut mais bien résolu!

 

Bonuscad ton code est aussi très interressant il offre d'autres possibilités que je vais exploiter.

 

Probleme Résolu! ;)

Merci à vous

Bonne journée

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • 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é