Aller au contenu

[CAD MAP 3D 2018] Générer 1 ligne + nom de calque


drault
 Partager

Messages recommandés

Bonjour,

Est-il possible de générer à partir des calques déjà présent dans un fichier, une succession de ligne + couleur propre en colonne et le nom respectif de chaque calque à côté par LISP ? Le VBA serait-il le plus adapté ?

Avant de poser ce problème, j'ai cherché mais peut-être avec les mauvais mots clés.

Bonne journée,

Lien vers le commentaire
Partager sur d’autres sites

les deux languauges sont adaptés => vu qu'ils peuvent faire la même chose ^^

et pour avoir une base de calques dans des txt / excel / word / base accessetc...  c'est largement faisable ^^

Il te faut :

savoir lire dans un fichier (Perso j'ai créé des fonctions pour extraire les données d'une valeur dans une base)

Créer des calques et attribuer des propiétés dessus

et ... c'est tout ^^

 

NomDuCalque;Couleur;Type de ligne;Epaisseur;Transparence;etc...

chaque colonne à un index

et tu cherches la bonne ligne avec le nom de ton calque par exemple

Lien vers le commentaire
Partager sur d’autres sites

Coucou,

Essaye avec ceci pour voir (j'ai testé vite fait et chat me semble correct), à voir si j'ai bien compris la demande ^^" :

(defun c:LAYERLIST (/ len rng htx ech pt doc layers ms i lck coe spt ept tpt obj txt)
  (setq
    len 2.0
    rng 1.0
    htx 0.25
    ech 1.0
    mod "ByLayer"
    pt '(0.0 0.0 0.0)
  )
  (if (= "Expert" (cond ((initget "Expert Auto")) ((getkword "\nComment souhaitez-vous utiliser le programme ? [Expert/Auto] <Auto> ")) ("Auto")))
    (setq
      len (cond ((initget (apply '+ '(2 4 64 1024)))) ((getdist (strcat "\nLongueur des lignes <" (rtos len) "> : "))) (len))
      rng (cond ((initget (apply '+ '(2 4 64 1024)))) ((getdist (strcat "\nEcart entre chaque ligne <" (rtos rng) "> : "))) (rng))
      htx (cond ((initget (apply '+ '(2 4)))) ((getreal (strcat "\nHauteur de texte <" (rtos htx) "> : "))) (htx))
      ech (cond ((initget (apply '+ '(2 4)))) ((getreal (strcat "\nEchelle du type de ligne <" (rtos ech) "> : "))) (ech))
      mod
        (cond
          ((initget "ByLayer Forced"))
          ((getkword (strcat "\nSouhaitez-vous affecter les calques aux lignes ou forcer les propriétés sur le calque courant [ByLayer/Forced] ? <" mod "> ")))
          (mod)
        )
      pt (cond ((getpoint (strcat "\nPoint d'insertion de la liste <" (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt)) "> :"))) (pt))
    )
  )
  (setq
    doc (vla-get-ActiveDocument (vlax-get-acad-object))
    layers (vla-get-layers doc)
    ms (vla-get-modelspace doc)
    i 0
    lck (vlax-get (setq layer (vla-item layers (getvar "CLAYER"))) 'Lock)
  )
  (vla-StartUndoMark doc)
  (if (= lck -1) (vlax-put layer 'Lock 0))
  (vlax-for layer layers
    (setq
      coe (* i rng)
      spt (mapcar '+ pt (list 0 (+ coe (* 0.5 htx)) 0))
      ept (mapcar '+ pt (list len (+ coe (* 0.5 htx)) 0))
      tpt (mapcar '+ pt (list (+ len (* 0.5 rng)) coe 0))
      obj (vla-AddLine ms (vlax-3d-point spt) (vlax-3d-point ept))
      txt (vla-AddText ms (vlax-get layer 'Name) (vlax-3d-point tpt) htx)
      i (1+ i)
    )
    (cond
      ( (= "ByLayer" mod)
        (vlax-put obj 'LinetypeScale ech)
        (vlax-put obj 'Layer (vlax-get layer 'Name))
      )
      ( (= "Forced" mod)
        (vlax-put obj 'TrueColor (vlax-get layer 'TrueColor))
        (vlax-put obj 'Lineweight (vlax-get layer 'Lineweight))
        (vlax-put obj 'Linetype (vlax-get layer 'Linetype))
        (vlax-put obj 'LinetypeScale ech)
      )
    )
  )
  (if (= lck -1) (vlax-put layer 'Lock -1))
  (vla-ZoomWindow (vlax-get-acad-object) (vlax-3d-point pt) (vlax-3d-point tpt))
  (princ
    (strcat
      "\nUn total de "
      (itoa i)
      " calques ont été listé au point d'insertion : "
      (vl-princ-to-string pt)
    )
  )
  (vla-EndUndoMark doc)
  (princ)
)

La première question permet de choisir entre exécuter le programme avec les valeurs par défaut (renseigner dans le premier (setq) du programme) (= "Auto") ou de poser une série de questions (= "Expert") pour pouvoir modifier ces valeurs ponctuellement.

Bisous,
Luna

Lien vers le commentaire
Partager sur d’autres sites

Rejoindre la conversation

Vous pouvez publier maintenant et vous inscrire plus tard. Si vous avez un compte, connectez-vous maintenant pour publier avec votre compte.

Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

Chargement
 Partager

×
×
  • 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é