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

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante