Calcul de surfaces avec applat de la couleur du calque

[fafamrx]

Bonjour à et bonne année 2023

Cela fait un certain temps que je cherche sur divers forum et autre et je suis arrivé sur le votre (Forum super intéressant mais super technique🥺)

Un lisp qui calcul la surface d'une polyligne, inscrit la surface dans la polyligne et met une hachure de la couleur du calque ou de la

polyligne.

J'en ai trouvé un (celui de duduleone,merci à lui) mais ne donne pas le résultat excompté (Cf : la capture d'écran).

Il y a des conseil de modifications à faire mais

Je vous avoue que je suis nul en lisp.

Pouuriez-vous me venir en aide sur ce sujet.

Je vous joint le lisp et la capture d'écan.

Encore merci à vous tous qui bénévolement aide des personnes comme moi.

Surfcoulcalk.lsp

[didier]

Bonjour @fafamrx

"une hachure de la couleur du calque ou de la polyligne."
Comment choisit-on entre les deux ?

Le LSP fourni est quelque peu verbeux.
Pour faire ce qui est demandé de façon simple, ce qui suit est suffisant :

(setq pol (entsel "\nChoix de la polyligne...\n"))
(setq vla_pol (vlax-ename->vla-object (car pol)))
(if (vlax-property-available-p vla_pol "Area")
  (progn
    (setq surf (vlax-get vla_pol 'Area))
    (setvar "HPNAME" "SOLID")
    (command "_.-bhatch" "_select" (car pol) "" "")
    (setvar "TEXTSIZE" 0.50)
    (command "_text" "_j" "_mc" (cadr pol) "0.50" "100.0" (strcat (rtos surf 2 2) " m²"))    
  )
  )

Amicalement

[fafamrx]

Il y a 20 heures, didier a dit :

Bonjour @fafamrx

"une hachure de la couleur du calque ou de la polyligne."
Comment choisit-on entre les deux ?

Le LSP fourni est quelque peu verbeux.
Pour faire ce qui est demandé de façon simple, ce qui suit est suffisant :

(setq pol (entsel "\nChoix de la polyligne...\n"))
(setq vla_pol (vlax-ename->vla-object (car pol)))
(if (vlax-property-available-p vla_pol "Area")
  (progn
    (setq surf (vlax-get vla_pol 'Area))
    (setvar "HPNAME" "SOLID")
    (command "_.-bhatch" "_select" (car pol) "" "")
    (setvar "TEXTSIZE" 0.50)
    (command "_text" "_j" "_mc" (cadr pol) "0.50" "100.0" (strcat (rtos surf 2 2) " m²"))    
  )
  )

Amicalement

Bonjour Didier

Merci de ce retour rapide.

"une hachure de la couleur du calque ou de la polyligne."

Une hachure du calque

Désolé de ma nullité, mais je mets cette partie du lisp ou dans celui d'origine?, ou sinon comment je peux le lancer?

Habituellement, je charge le lisp et le lance par son nom.

Mille excuse d'être si nul.

Encore merci de ton aide

 

 

[didier]

Bonjour @fafamrx

Nul est un état, il ne faut pas s'en excuser, c'est un état qui ne dure pas si on a envie d'apprendre.
Une hachure du calque  : je comprends "ducalque", donc couleur et type de ligne "ducalque".

Charge ce qui suit en l'ayant précédemment enregistré au format texte avec LSP comme extension.
Il ne faut pas l'insérer dans le LSP initial, ces quelques lignes font le job
Le nom de la commande est polhs.

Amicalement

(defun c:polhs ( / pol surf vla_pol)
  (setq pol (entsel "\nChoix de la polyligne...\n"))
  (setq vla_pol (vlax-ename->vla-object (car pol)))
  (if (vlax-property-available-p vla_pol "Area")
    (progn
      (setq surf (vlax-get vla_pol 'Area))
      (setvar "HPNAME" "SOLID")
      (command "_.-bhatch" "_select" (car pol) "" "")
      (setvar "TEXTSIZE" 0.50)
      (command "_text" "_j" "_mc" (cadr pol) "0.50" "100.0" (strcat (rtos surf 2 2) " m²"))
      )
    )
  )

 

[fafamrx]

Merci Didier 

Je teste cela tout de suite

Encore Merci

[fafamrx]

Re_Bonjour Didier

Haie, désolé de dire cela mais ça ne foctionne pas.

Il faut que je celection polilygne par polilygne est il possible de faire en sorte de toutes les selectionner d'un coup.

Est-il possible de mettre les achure d'un un calque qui se vrée tous seul (ex : Hach) et de mettre le texte des surface dans

le calque de la polyligne un peu comme le lisp de Duduleone?

Désolé du dérangement.

Milles merci Didier

[PHILPHIL]

hello Fafamrx

sinon tu fais comme avant avec ton premier LISp.

et apres une fois que tu as mis tes texte de surface par rapport a tes polylignes ranger dans les bons calques.

tu appliques ce lisp, qui remplis les polylignes avec une hachure SOLID. dans un calque dedier aux hachures

 

fonction : HACHURE_SUIVANT_CALQUE_POLYLIGNE

Phil
 

;;; ---------------------------------------------
;;; REMPLIT PAR UN HACHURAGE SOLIDE LES POLYLIGNES FERMEE DANS LE CALQUE DE LA POLYLIGNE
;;; ---------------------------------------------


(defun c:hachure_suivant_calque_polyligne (/)
  (setvar "cmdecho" 0)
  (setvar "dimzin" 0)
  (setvar "osmode" 0)
  (setq cav     (getvar "clayer")
        osm     (getvar "osmode")
        hachnam (getvar "hpname")
        hachech (getvar "hpscale")
        hachang (getvar "hpang")
        hachdet (getvar "HPISLANDDETECTION")
        hachlay (getvar "hplayer")
  )
  (princ "\n")
  (princ "\n")
  (prompt "\nCLIQUER SUR L'ENTITE(S) POLYLIGNE(S) A HACHURER :")
  (setq lespoly nil)
  (while (null lespoly)
    (setq lespoly (ssget (list (cons -4 "<or")
                               (cons 0 "CIRCLE")
                               (cons 0 "polyline")
                               (cons 0 "lwpolyline")
                               (cons 0 "AEC_POLYGON")
                               (cons -4 "or>")
                         )
                  )
    )
  )
  (setq ferm nil)
  (setq compt 0)
  (setvar "hpname" "SOLID")
  (setvar "hpscale" 1)
  (setvar "hpang" 0)
  (setvar "HPISLANDDETECTION" 2)
  (setq com (sslength lespoly))
  (while (< compt com)
    (progn (setq unepoly (ssname lespoly compt)
                 forme   (cdr (assoc 0 (entget unepoly)))
                 ferm    (cdr (assoc 70 (entget unepoly)))
                 nbpoint (cdr (assoc 90 (entget unepoly)))
                 calq    (cdr (assoc 8 (entget unepoly)))
                 laycol  (cdr (assoc 62 (tblsearch "layer" calq)))
           )
           (if (= forme "CIRCLE")
             (setq ferm 1
                   nbpoint 3
             )
           )
           (if (= forme "AEC_POLYGON")
             (setq ferm 1
                   nbpoint 3
             )
           )
           (if (and (or (= ferm 129) (= ferm 1)) (> nbpoint 2))
             (progn (if (= (tblsearch "layer" (strcat calq " HACHURE")) nil)
                      (command-s "-calque"
                                 "n"
                                 (strcat calq " HACHURE")
                                 "co"
                                 laycol
                                 (strcat calq " HACHURE")
                                 "T"
                                 "A"
                                 (strcat calq " HACHURE")
                                 ""
                      )
                    )
                    (command-s "-calque" "ac" (strcat calq " HACHURE") "ch" (strcat calq " HACHURE") "")
;;;                    (setvar "hplayer" (strcat calq " HACHURE"))
                    (command-s "-fhach" "SE" unepoly "" "")
             )
           )
           (setq compt (1+ compt))
    )
  )
  (princ)
  (setq compt 0)
  (initget "n N")
  (setq ans (getkword "EST CE QUE LE HACHURAGE VOUS CONVIENT ? (O/N):"))
  (if (or (= ans "n") (= ans "N"))
    (progn (while (< compt com) (command-s "ANNULER" "") (setq compt (1+ compt))))
  )
  (setvar "osmode" osm)
  (setvar "clayer" cav)
  (setvar "hpname" hachnam)
  (setvar "hpscale" hachech)
  (setvar "hpang" hachang)
  (setvar "hplayer" hachlay)
  (setvar "HPISLANDDETECTION" hachdet)
  (princ)
)

 

 

[didier]

Bonjour @fafamrx

Quand je fais tourner le LSP fourni il correspond bien à la nouvelle demande.
Si on répond Oui à la première invite, les hachures et les textes sont dans des calques spécifiques.

C'est quoi exactement ton attente ?

Amicalement

PS : Merci de te relire avant de poster le message pour corriger les éventuelles fautes de frappe qui rendent le message dur à interpréter.
 

[fafamrx]

Bonjour Didier et Phil

Encore merci à vous

@Didier

En effet le lisp fourni à l'origine fonction bien, mais le but est que les hachures soient de la couleur de la polyligne

Actuellement, un calque est créé pour les surfaces et un autre pour les hachures.

Mais ils sont créés avec la couleur "Blanc" et non pas avec la couleur de la polyligne

@Phil

Merci pour la routine. Je l'ai essayé mais elle se bloque sur

"EST CE QUE LE HACHURAGE VOUS CONVIENT ? (O/N)"

Désolé pour les fautes et de mon insistance.

Cordialement,

 

[didier]

Bonjour @fafamrx

Le souci, c'est que le LSP fourni est inutilement compliqué et ce n'est pas simple de rentrer dedans !
Je fatigue et je laisse la main à ceux qui veulent le décortiquer...

Si tu avais émis l'envie d'apprendre le langage, j'aurais été plus motivé.

Amicalement

[PHILPHIL]

hello

il y a une heure, fafamrx a dit :

"EST CE QUE LE HACHURAGE VOUS CONVIENT ? (O/N)"

c'est une question , donc  répondre par "n" ou "N" si ca ne convient pas.

si ca convient "valider " par "enter"  ou clique "droit souris" tout simplement.

 si on repond par "n" ou "N"  ca annule tout ce qui a été creer avant, donc le hachurage.

 (setq ans (getkword "EST CE QUE LE HACHURAGE VOUS CONVIENT ? (O/N):"))
  (if (or (= ans "n") (= ans "N"))
    (progn (while (< compt com) (command-s "ANNULER" "") (setq compt (1+ compt))))
  )

Phil