Evolution DS2

Magdi95 · le 31 mars 2010

Bonjour à tous,

J'utilise le lisp suivant:

;

;; allows for continuous distance measurements
;; with an enity selection option and a total
;; of all measurements made
(defun
    ERR_DIS (ERR_MSG) ; error control
 (prompt "\nOuch... ")
 (DIS_BACK)
) ; end defun err_dis
(defun
    DIS_SET ()
 (setq DIS_ERR *ERROR*)
 (setq *ERROR* ERR_DIS)
 (setvar "cmdecho" 0)
 (princ)
) ; end dis_set
(defun
    DIS_BACK ()
 (setq *ERROR* DIS_ERR)
 (if (/= DIS_DEL NIL)
   (progn
     (foreach
          DIS_E DIS_DEL
       (entdel DIS_E)
     ) ;end foreach
   ) ;end progn
 ) ;end if
 (setvar "cmdecho" 1)
 (princ)
) ; end dis_back
;
(defun
    ASO (NUM LST)
 (cdr (assoc NUM LST))
) ;_ end of defun
;*********************
;; Main routine start
(defun
    C:DS2 (/ DIS_LIST DIS_UNIT DIS_SIG DIS_VAL DIS_REAL  DIS_SHOW
          DIS_LAST DIS_START DIS_PT1 DIS_PT2 GO_SEL
         );DIS_POP
 (DIS_SET)
 (princ "\nDistance ")
 (setq DIS_LIST NIL)
 (setq DIS_START NIL)
 (setq DIS_UNIT (getvar "lunits"))
 (setq DIS_SIG (getvar "luprec"))
 (setq DIS_DEL NIL)
 (initget 128 "S")
 (setq DIS_PT1 (getpoint "\nFirst point or (S)elect entity: "))
 (cond
   ((/= DIS_PT1 "S")
    (setq GO_SEL "nope")
    (setq DIS_START DIS_PT1)
   )
   ((= DIS_PT1 "S")
    (setq GO_SEL "yep")
    (DIS_SEL)
   )
 ) ;end cond
 (while (/= DIS_PT1 NIL)
   (cond
     ((= GO_SEL "nope")
      (initget 128 "N S C")
      (setq DIS_PT2
             (getpoint
               DIS_PT1
               "\nNext point, (N)ew point, (S)elect entity or : "
             ) ;_ end of getpoint
      ) ;_ end of setq
      (if (= DIS_PT2 NIL)
        (setq DIS_PT1 NIL)
      ) ;_ end of if
     )
     ((= GO_SEL "yep")
      (setq DIS_PT2 NIL)
      (setq GO_SEL "nope")
      (initget 128 "S C")
      (setq DIS_PT1
             (getpoint
               "\nFirst point or (S)elect entity or : "
             ) ;_ end of getpoint
      ) ;_ end of setq
      (if (or (= DIS_PT1 "S") (= DIS_PT1 "C"))
        (setq DIS_PT2 DIS_PT1)
      ) ;_ end of if
     )
   ) ;end cond
   (cond
     ((and (/= DIS_PT2 NIL)
           (/= DIS_PT2 "N")
           (/= DIS_PT2 "S")
           (/= DIS_PT2 "C")
      ) ;_ end of and
      (setq GO_SEL "nope")
      (setq DIS_VAL (distance DIS_PT1 DIS_PT2))
      (setq DIS_REAL (rtos DIS_VAL DIS_UNIT DIS_SIG))
      (setq DIS_SHOW (distof DIS_REAL DIS_UNIT))
      (princ DIS_REAL)
      (if (/= DIS_LIST NIL)
        (setq DIS_LIST (+ DIS_LIST DIS_SHOW))
        (setq DIS_LIST DIS_SHOW)
      ) ;_ end of if
      (DIS_LINE DIS_PT1 DIS_PT2)
      (setq DIS_PT1 DIS_PT2)
     )
     ((= DIS_PT2 "N") ; new point option
      (setq GO_SEL "nope")
      (setq DIS_PT1 (getpoint "\nFirst point: "))
     )
     ((= DIS_PT2 "S") ; select entity option
      (setq GO_SEL "yep")
      (DIS_SEL)
     )
     ((= DIS_PT2 "C") ; close option
      (setq DIS_VAL (distance DIS_PT1 DIS_START))
      (setq DIS_REAL (rtos DIS_VAL DIS_UNIT DIS_SIG))
      (setq DIS_SHOW (distof DIS_REAL DIS_UNIT))
      (princ DIS_REAL)
      (setq DIS_LIST (+ DIS_LIST DIS_SHOW))
      (DIS_LINE DIS_PT1 DIS_START)
      (setq DIS_PT1 DIS_START)
     )
   ) ;end cond
 ) ;end while
 (if (/= DIS_LIST NIL)
   (progn ; 3
     (setq DIS_POP (rtos DIS_LIST DIS_UNIT DIS_SIG))
     (princ (strcat "\nDistance totale : " DIS_POP))
   ) ;end progn 3
 ) ;end if
 (DIS_BACK)
 (princ)

;;  Complément par F.Loutan, le 02.09.2005
(setq dml1 (atof DIS_POP));transformer en réel
(setq dml2 (/ dml1 100)) ;facteur d'échelle du résultat
(setq dml3 (rtos dml2 2 2));transformer esn string pour ajouter le ml
(setq dml2 (strcat dml3 "ml"))
(alert (strcat "\nLa longueur de l'objet est de: " dml2))
; (setvar "cmdecho" cmdecho)
  (setq e (car (nentsel "\choix de l'attribut")))
  (setq ent (entget e))
  ;(prompt "\nSelectionnez le texte de l'attribut a remplacer ...:")
  (entmod (subst (cons 1 dml2) (assoc 1 ent) ent))
  (entupd e)
  ;(command "changer" pause "" "" "" "" "" "" taire2)
(prompt "\nBy FL 02.09.2005 ")
(princ)
 
) ;end DS
;


(defun
    DIS_LINE (ONE TWO / DIS_TRACE DIS_LAST DIS_GOT DIS_NM)
; distance tracing function one
 (setq DIS_TRACE
        (list (cons 0 "LINE")
              (cons 10 ONE)
              (cons 11 TWO)
              (cons 62 5)
        ) ;_ end of list
 ) ;_ end of setq
 (entmake DIS_TRACE)
 (setq DIS_LAST (entlast))
 (setq DIS_GOT (entget DIS_LAST))
 (setq DIS_NM (ASO -1 DIS_GOT))
 (if (/= DIS_DEL NIL)
   (setq DIS_DEL (cons DIS_NM DIS_DEL))
   (setq DIS_DEL (list DIS_NM))
 ) ;_ end of if
) ;end dis_line
;



(defun
    DIS_COPY
    (/ SEL_LAY SEL_NO SEL_CHK SEL_LIST SEL_LAST SEL_GOT SEL_NM)
; distance tracing function two
 (setq SEL_LAY (getvar "clayer"))
 (setq SEL_LIST NIL)
 (foreach
      SEL_NO SEL_GET
   (setq SEL_CHK (car SEL_NO))
   (if (and (/= SEL_CHK -1) (/= SEL_CHK 5))
     (progn
       (cond
         ((= SEL_CHK 8)
          (setq SEL_NO (cons 8 SEL_LAY))
         )
         ((and (= ANG_GO "yep") (= SEL_CHK 50))
          (setq SEL_NO (cons 50 SEL_ANG1))
         )
         ((and (= ANG_GO "yep") (= SEL_CHK 51))
          (setq SEL_NO (cons 51 SEL_ANG2))
         )
       ) ;end cond
       (if (/= SEL_LIST NIL)
         (setq SEL_LIST (cons SEL_NO SEL_LIST))
         (setq SEL_LIST (list SEL_NO))
       ) ;_ end of if
     ) ;end progn
   ) ;end if
 ) ;end foreach
 (setq SEL_LIST (cons (cons 62 5) SEL_LIST))
 (setq SEL_LIST (reverse SEL_LIST))
 (entmake SEL_LIST)
 (setq SEL_LAST (entlast))
 (setq SEL_GOT (entget SEL_LAST))
 (setq SEL_NM (ASO -1 SEL_GOT))
 (if (/= DIS_DEL NIL)
   (setq DIS_DEL (cons SEL_NM DIS_DEL))
   (setq DIS_DEL (list SEL_NM))
 ) ;_ end of if
) ;end dis_copy
;



(defun
    DIS_SEL (/ SEL_GO SEL_NENT SEL_PNT SEL_GET SEL_TYPE DIS_ANS1
             DIS_ANS2 SEL_CEN SEL_RAD SEL_ANG1 SEL_ANG2 DIS_ANS SEL_PI
             SEL_DLTA SEL_BEG SEL_END SEL_LEN SEL_NO SEL_CHK DIS_REAL
             DIS_SHOW
            ) ; entity selection option
 (setq DIS_PT1 NIL)
 (setq SEL_GO "yep")
 (while (= SEL_GO "yep")
   (setq SEL_NENT NIL)
   (setvar "osmode" 512)
   (setq SEL_PNT (getpoint "\nSelect entity: "))
   (setvar "osmode" 0)
   (if (= SEL_PNT NIL)
     (setq SEL_GO "out")
   ) ;_ end of if
   (if (/= SEL_PNT NIL)
     (setq SEL_NENT (nentselp SEL_PNT))
   ) ; even if in a block
   (if (/= SEL_NENT NIL)
     (progn ; 1
       (setq SEL_GET (entget (car SEL_NENT))) ; get entity data
       (setq SEL_TYPE (ASO 0 SEL_GET))
       (cond
         ((= SEL_TYPE "ARC") ; arc distance
          (setq ANG_GO "nope")
          (setq DIS_ANS1 NIL)
          (setq DIS_ANS2 NIL)
          (setq SEL_CEN (ASO 10 SEL_GET))
          (setq SEL_RAD (ASO 40 SEL_GET))
          (setq SEL_ANG1 (ASO 50 SEL_GET))
          (setq SEL_ANG2 (ASO 51 SEL_GET))
          (initget "S")
          (setq DIS_ANS
                 (getkword
                   "\n(S)elect points on arc or ? "
                 ) ;_ end of getkword
          ) ;_ end of setq
          (if (/= DIS_ANS NIL)
            (progn ; 1
              (setq ANG_GO "yep")
              (setvar "osmode" 512)
              (setq DIS_ANS1 (getpoint "\nFirst point: "))
              (if (/= DIS_ANS1 NIL)
                (setq DIS_ANS2 (getpoint "\nSecond point: "))
              ) ;_ end of if
              (setvar "osmode" 0)
              (if (/= DIS_ANS2 NIL)
                (progn ; a
                  (setq SEL_ANG2 (angle SEL_CEN DIS_ANS1))
                  (setq SEL_ANG1 (angle SEL_CEN DIS_ANS2))
                ) ;end progn a
                (princ "**The arc's original endpoints were used.**")
              ) ;end if
            ) ;end progn 1
          ) ;end if
          (setq SEL_PI (* pi 2.0))
          (setq SEL_DLTA (- SEL_ANG2 SEL_ANG1))
          (if (>= SEL_DLTA SEL_PI)
            (setq SEL_DLTA (- SEL_PI SEL_DLTA))
          ) ;_ end of if
          (if (< SEL_DLTA 0)
            (setq SEL_DLTA (+ SEL_PI SEL_DLTA))
          ) ;_ end of if
          (setq DIS_REAL (rtos (* SEL_RAD SEL_DLTA) DIS_UNIT DIS_SIG))
          (setq DIS_SHOW (distof DIS_REAL DIS_UNIT))
          (princ DIS_REAL)
          (if (/= DIS_LIST NIL)
            (setq DIS_LIST (+ DIS_LIST DIS_SHOW))
            (setq DIS_LIST DIS_SHOW)
          ) ;_ end of if
          (setq DIS_PT1 (polar SEL_CEN SEL_ANG2 SEL_RAD))
          (if (= DIS_START NIL)
            (setq DIS_START (polar SEL_CEN SEL_ANG1 SEL_RAD))
          ) ;_ end of if
          (DIS_COPY)
         )
         ((= SEL_TYPE "LINE") ; line distance
          (setq SEL_BEG (ASO 10 SEL_GET))
          (setq SEL_END (ASO 11 SEL_GET))
          (setq SEL_LEN (distance SEL_BEG SEL_END))
          (setq DIS_REAL (rtos SEL_LEN DIS_UNIT DIS_SIG))
          (setq DIS_SHOW (distof DIS_REAL DIS_UNIT))
          (princ DIS_REAL)
          (if (/= DIS_LIST NIL)
            (setq DIS_LIST (+ DIS_LIST DIS_SHOW))
            (setq DIS_LIST DIS_SHOW)
          ) ;_ end of if
          (setq DIS_PT1 SEL_END)
          (if (= DIS_START NIL)
            (setq DIS_START SEL_BEG)
          ) ;_ end of if
          (DIS_COPY)
         )
         ((or (= SEL_TYPE "LWPOLYLINE") (= SEL_TYPE "POLYLINE"))
; polyline distance
          (command "_AREA" "o" SEL_NENT)
          (setq SEL_LEN (getvar "perimeter"))
          (setq DIS_REAL (rtos SEL_LEN DIS_UNIT DIS_SIG))
          (setq DIS_SHOW (distof DIS_REAL DIS_UNIT))
          (princ DIS_REAL)
          (if (/= DIS_LIST NIL)
            (setq DIS_LIST (+ DIS_LIST DIS_SHOW))
            (setq DIS_LIST DIS_SHOW)
          ) ;_ end of if
          (setq SEL_BEG NIL)
          (foreach
               SEL_NO SEL_GET
            (setq SEL_CHK (car SEL_NO))
            (if (= SEL_CHK 10)
              (progn
                (setq SEL_END (cdr SEL_NO))
                (if (= SEL_BEG NIL)
                  (setq SEL_BEG SEL_END)
                ) ;_ end of if
              ) ;end progn
            ) ;end if
          ) ;end foreach
          (setq DIS_PT1 SEL_END)
          (if (= DIS_START NIL)
            (setq DIS_START SEL_BEG)
          ) ;_ end of if
          (DIS_COPY)
         )
         ((= SEL_TYPE "CIRCLE") ; circle circumference
          (command "_AREA" "o" SEL_NENT)
          (setq SEL_LEN (getvar "perimeter"))
          (setq DIS_REAL (rtos SEL_LEN DIS_UNIT DIS_SIG))
          (setq DIS_SHOW (distof DIS_REAL DIS_UNIT))
          (princ (strcat "circumference " DIS_REAL))
          (if (/= DIS_LIST NIL)
            (setq DIS_LIST (+ DIS_LIST DIS_SHOW))
            (setq DIS_LIST DIS_SHOW)
          ) ;_ end of if
          (setq DIS_PT1 SEL_PNT)
          (if (= DIS_START NIL)
            (setq DIS_START SEL_PNT)
          ) ;_ end of if
          (DIS_COPY)
         )
       ) ;end cond
     ) ;end progn 1
   ) ;end if
 ) ;end while
) ;end dis_sel

Il m'est utile pour faire des mettrés de cables pour des postes de travail informatique.

Le seul probleme est qu'il me propose d'appliquer la longueur totale a un seul attribut donc obliger de faire cette manip a chaque fois, meme pour un poste a quelque metres :mad: .

Comment faire pour qu'il me propose d'appliquer la valeur "cumulée" donc à chaque pointage :exclam: .

D'autre part la distance totale renseignée dans la fenetre de texte d'autocad (ex:13.87) est bien en metre mais lorsqu'il renseigne l'attribut il met 0.13ml. Peut-on avoir la distance 13.87 dans l'etiquette et sans "ml".

Par avance Merci

Bonne journée

Magdi[Edité le 31/3/2010 par Magdi95]

Connexion

Evolution DS2

Messages recommandés

Magdi95

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante