Programme lisp

[arbtlm]

Bonjour, je cherche quelqu'un capable de m'écrire un LISP pour faire ceci:

1) selection d'un premier bloc avec attribut (TCPOINT), récuperation de la valeur de l'attribut ALT

2) selection d'un deuxieme bloc avec attribut  (TCPOINT), récuperation de la valeur de l'attribut ALT

3) insertion du bloc ALTI avec remplissage des attributs, ZTN= valeur récuperée dans le bloc 1, ZSG= valeur recuperée dans le bloc 2, CH=ZTN-ZSG

bloc inseré au point d'insertion du deuxieme bloc.

En piece joint le fichier DWG avec les 3 blocs

Merci d'avance

[Anonymous · Accepted solution]

Bonjour arbtlm,

Voilà ce qui devrais correspondre à ta demande.

(defun c:arbtlm (/ TCP1 TCP2 ent alt1 alt2)
  (while (= TCP1 nil)
    (setq TCP1 (car (entsel)))
    (if (or (= TCP1 nil)
        (/= (cdr (assoc 0 (entget TCP1))) "INSERT")
        (/= (cdr (assoc 2 (entget TCP1))) "TCPOINT")
        (/= (cdr (assoc 66 (entget TCP1))) 1)
        )
      (progn
    (Princ "/nSélectionnez un un TCPOINT")
    (setq TCP1 nil)
    )
      )
    )
  (while (= TCP2 nil)
    (setq TCP2 (car (entsel)))
    (if (or (= TCP2 nil)
        (/= (cdr (assoc 0 (entget TCP2))) "INSERT")
        (/= (cdr (assoc 2 (entget TCP2))) "TCPOINT")
        (/= (cdr (assoc 66 (entget TCP2))) 1)
        )
      (progn
    (Princ "/nSélectionnez un un TCPOINT")
    (setq TCP2 nil)
    )
      )
    )
  (setq ent (entnext tcp1))
  (while (/= (cdr (assoc 0 (entget ent))) "SEQEND")
    (if (and (= (cdr (assoc 0 (entget ent))) "ATTRIB")
         (= (cdr (assoc 2 (entget ent))) "ALT")
         )
      (setq alt1 (cdr (assoc 1 (entget ent))))
      )
    (setq ent (entnext ent))
    )
  (setq ent (entnext tcp2))
  (while (/= (cdr (assoc 0 (entget ent))) "SEQEND")
    (if (and (= (cdr (assoc 0 (entget ent))) "ATTRIB")
         (= (cdr (assoc 2 (entget ent))) "ALT")
         )
      (setq alt2 (cdr (assoc 1 (entget ent))))
      )
    (setq ent (entnext ent))
    )
  (if
    (and (/= alt1 nil) (/= alt1 "") (/= alt2 nil) (/= alt2 ""))
    (progn
      (setvar "attdia" 0)
      (setvar "cmdecho" 0)
      (command "_-insert" "ALTI" (cdr (assoc 10 (entget tcp2))) 1 1 0 alt1 alt2 (rtos (- (read alt1) (read alt2))2 2) )
      (setvar "cmdecho" 1)
      (setvar "attdia" 1)
      )
    (princ "\nRemplissez les valeurs d'altimétrie des blocs TCPOINT")
    )
  (princ)
  )

Olivier

[arbtlm]

Merci beaucoup Olivier, ton programme marche tres bien.

C'est super des gars comme toi.

[Anonymous]

C'est super des gars comme toi

Merci !

Voici une version améiorée pour éviter une erreur au cas où le bloc ALTI n'existe pas dans le plan et si tu as des accroches objets proche du point d'insertion.

(defun c:arbtlm (/ TCP1 TCP2 ent alt1 alt2)
  (while (= TCP1 nil)
    (setq TCP1 (car (entsel)))
    (if (or (= TCP1 nil)
        (/= (cdr (assoc 0 (entget TCP1))) "INSERT")
        (/= (cdr (assoc 2 (entget TCP1))) "TCPOINT")
        (/= (cdr (assoc 66 (entget TCP1))) 1)
        )
      (progn
    (Princ "/nSélectionnez un un TCPOINT")
    (setq TCP1 nil)
    )
      )
    )
  (while (= TCP2 nil)
    (setq TCP2 (car (entsel)))
    (if (or (= TCP2 nil)
        (/= (cdr (assoc 0 (entget TCP2))) "INSERT")
        (/= (cdr (assoc 2 (entget TCP2))) "TCPOINT")
        (/= (cdr (assoc 66 (entget TCP2))) 1)
        )
      (progn
    (Princ "/nSélectionnez un un TCPOINT")
    (setq TCP2 nil)
    )
      )
    )
  (setq ent (entnext tcp1))
  (while (/= (cdr (assoc 0 (entget ent))) "SEQEND")
    (if (and (= (cdr (assoc 0 (entget ent))) "ATTRIB")
         (= (cdr (assoc 2 (entget ent))) "ALT")
         )
      (setq alt1 (cdr (assoc 1 (entget ent))))
      )
    (setq ent (entnext ent))
    )
  (setq ent (entnext tcp2))
  (while (/= (cdr (assoc 0 (entget ent))) "SEQEND")
    (if (and (= (cdr (assoc 0 (entget ent))) "ATTRIB")
         (= (cdr (assoc 2 (entget ent))) "ALT")
         )
      (setq alt2 (cdr (assoc 1 (entget ent))))
      )
    (setq ent (entnext ent))
    )
  (if
    (tblsearch "BLOCK" "ALTI")
    (if
      (and (/= alt1 nil alt1 "" alt2 nil alt2 ""))
	  (progn
	    (setvar "attdia" 0)
	    (setvar "cmdecho" 0)
	    (command "_-insert" "ALTI" "_non" (cdr (assoc 10 (entget tcp2))) 1 1 0 alt1 alt2 (rtos (- (read alt1) (read alt2))2 2) )
	    (setvar "cmdecho" 1)
	    (setvar "attdia" 1)
	    )
	  (princ "\nRemplissez les valeurs d'altimétrie des blocs TCPOINT".)
      )
    (princ "\nLa référence de bloc ALTI n'existe pas.")
    )
  (princ)
  )

Bonne journée

Olivier

[arbtlm]

Bonjour,

une petite modif si possible:

Insertion du bloc dans les coordonnées du SCU et non paas du SCG

Merci d'avance

[Anonymous]

bonjour, 

je cherche un programme LISP qui pourra inserer mes points sous forme des blocs avec des attributs ( Nom; Élévation, Discription) ;

sachant que je voudrait inserer mes points en 3D (XYZ) et avec des achelles (XYZ) aussi un calque spécifique

y'aura t il quelcun qui pourra m'aider ?

voila un exemple du text que je veux inserer sur autocad  

Nom du bloc Calque ELEV POINT DESC Echelle X Echelle Y Echelle Z Position X Position Y Position Z Rotation
point E-GEO-POINT-LEVE_SNC 0.002 10192 DALLE_Z 63.5000 63.5000 63.5000 69576.8494 65073.0985 2.0000 1
point E-GEO-POINT-LEVE_SNC -0.001 9888 DALLE_Z 63.5000 63.5000 63.5000 71182.7274 66826.8345 -1.0000 -45
point E-GEO-POINT-LEVE_SNC -0.008 10212 DALLE_Z 63.5000 63.5000 63.5000 59722.9157 55507.1667 -8.0000 1
point E-GEO-POINT-LEVE_SNC -0.012 10209 DALLE_Z 63.5000 63.5000 63.5000 63013.7104 53843.8405 -12.0000 1
point E-GEO-POINT-LEVE_SNC -0.007 10210 DALLE_Z 63.5000 63.5000 63.5000 61905.1917 53939.7786 -7.0000 1
point E-GEO-POINT-LEVE_SNC -0.007 10217 DALLE_Z 63.5000 63.5000 63.5000 63049.0458 51079.0439 -7.0000 1
point E-GEO-POINT-LEVE_SNC -0.001 10220 DALLE_Z 63.5000 63.5000 63.5000 64672.5598 50564.3447 -1.0000 1
point E-GEO-POINT-LEVE_SNC -0.005 10221 DALLE_Z 63.5000 63.5000 63.5000 64038.7505 50553.8644 -5.0000 135
point E-GEO-POINT-LEVE_SNC -0.007 10218 DALLE_Z 63.5000 63.5000 63.5000 61893.0763 51078.2946 -7.0000 1
point E-GEO-POINT-LEVE_SNC -0.010 10219 DALLE_Z 63.5000 63.5000 63.5000 64622.3787 52197.6217 -10.0000 45
point E-GEO-POINT-LEVE_SNC -0.007 10202 DALLE_Z 63.5000 63.5000 63.5000 67873.9514 55547.8307 -7.0000 1