nuage de révision sous la 2002 ?

[Oli35]

Bonjour à tous !

 

Est-il perdu ou le "nuage de révision" n'existe pas sous la version 2002 ?

 

Y a-t-il moyen de l'intégrer ?

 

Merci d'avance.

[Eric]

Juqu'à AutoCAD 2002 le nuage était disponible uniquement dans le menu Express, mais comme avec 2000 i et 2002 le menu était payant...

 

Sinon il est disponible en standard depuis AutoCAD 2004 et sur AutoCAD LT depuis plus longtemps

 

[x13]

Voiçi 2 petits programmes LISP qui devraient résoudre ton problème.

 

;| REVCLOUD.LSP

Copyright © 1997 by Autodesk, Inc.

 

Permission to use, copy, modify, and distribute this software

for any purpose and without fee is hereby granted, provided

that the above copyright notice appears in all copies and

that both that copyright notice and the limited warranty and

restricted rights notice below appear in all supporting

documentation.

 

AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.

AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF

MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.

DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE

UNINTERRUPTED OR ERROR FREE.

 

Use, duplication, or disclosure by the U.S. Government is subject to

restrictions set forth in FAR 52.227-19 (Commercial Computer

Software - Restricted Rights) and DFAR 252.227-7013©(1)(ii)

(Rights in Technical Data and Computer Software), as applicable.

 

Last revision 10/02/97 Bob Abernethy, dba/CADesigner

 

 

Credits: Original Code, idea and concept by David Harrington

Bill Kramer, Q.C.

Phil Kreiker, Q.C.

Dominic Panholzer, Q.C.

Randy Kinsley, Error Control

Greg Robinson

Bob Abernethy, dba/CADesigner, Added Incremental numbered revision

callout triangle & Layer control

|;

 

(defun input_integer (a b / c)

(setq a (strcat a " <"(rtos b 2 0)"> "))

(setq c (getint a))

(if (/= c NIL)

(setq b c)

(setq b b)

)

)

(setq incr 1)

 

(defun item (ent)

(cdr(car(entget(ent))))

)

 

(defun ERR (s)

(if (/= s "Function cancelled\n")

(if (= s "quit / exit abort")

(princ)

(alert (strcat " >> Error << \n"))

)

)

(setvar "CLAYER" CL)

(setq *error* olderr)

(princ)

)

 

(Defun C:REVCLOUD (/

ARC_DIST ;;radius of included arc

INC_ANGLE ;;included angle in degrees

LAST_PT ;;the last point just entered/shown

START_PT ;;where the cloud began

NEXT_PT ;;where we are going next

TMP ;;tempory holder for radius of bulge

)

(setq olderr *error* *error* err)

(setq ce (getvar "cmdecho"))

(setq blp (getvar "blipmode"))

(setq osm (getvar "osmode"))

(setvar "cmdecho" 0)

(setvar "blipmode" 0)

(setvar "osmode" 0)

(setq cl (getvar"clayer"))

(if (not (tblsearch "LAYER" "rcloud"))

(command "layer" "m" "rcloud" "c" "12" "rcloud" "")

)

(command "layer" "s" "rcloud" "")

 

;;--------real program starts here!

 

(Setq INC_ANGLE 110)

 

(if (and

(/= "" (getcfg "AppData/AC_Bonus/Revcld_Bulge"))

(/= nil (getcfg "AppData/AC_Bonus/Revcld_Bulge"))

)

(setq ARC_DIST (atof (getcfg "AppData/AC_Bonus/Revcld_Bulge")))

(if (= (getvar "DIMSCALE") 0)

(setq ARC_DIST 0.375)

(setq ARC_DIST (* 0.375 (getvar "DIMSCALE")))

)

);end if

 

(prompt (strcat "\nArc length set at " (rtos ARC_DIST 2 3)))

(setq plwid (getvar"plinewid"))

(setvar "plinewid" (* (getvar"dimscale")0.0078)); use for wider than zero pline width

; (setvar"plinewid" 0.0); use for zero pline width

(setq om (getvar"orthomode"))

(setvar "orthomode" 0)

(initget "Arc")

(setq LAST_PT (GetPoint "\nArc longeur/: "))

 

(if (= LAST_PT "Arc")

(progn

(initget 6)

(setq TMP (getdist (strcat "\nArc length <" (rtos ARC_DIST 2 3) ">: ")))

(if TMP

(Progn

(setq ARC_DIST TMP)

;R14 method of saving variable values

(setcfg "AppData/AC_Bonus/Revcld_Bulge" (rtos ARC_DIST))

)

)

(setq LAST_PT (getpoint "\nDéterminez point de départ du nuage: "))

) ;;end STR "RADIUS" test

)

 

(if LAST_PT (progn ;;start up the cloud generator...

(setq START_PT LAST_PT

SAVED_EN (entlast))

(Prompt "\nGuide crosshairs along cloud path...")

(Command

"_.pline" ;draw cloud as a polyline on current layer

LAST_PT

"_a" ;specify arc option

"_a" ;specify angle option

INC_ANGLE ;included angle

)

)) ;end IF LAST_PT

 

(While LAST_PT ;;as long as we have a last point value,

 

(Setq NEXT_PT (GrRead 1) ;;real time read

READTYP (car NEXT_PT)

)

(if (or (= 5 READTYP) (= READTYP 3)) ;;read a position or a pick?

(progn

(setq NEXT_PT (cadr NEXT_PT))

(If (or (> (Distance LAST_PT NEXT_PT) ARC_DIST) (= READTYP 3))

(Progn

(Command NEXT_PT "_a" INC_ANGLE)

(Setq LAST_PT NEXT_PT)

)

)

(If (>

(Distance LAST_PT NEXT_PT)

(Distance START_PT NEXT_PT)

)

(Progn

(Command START_PT "_cl")

(Setq LAST_PT Nil)

(prompt "\nNuage terminé.")

)

)

)

(prompt "\nDéplacer le pointeur pour dessiner le nuage")

);End if

);End while

(setvar "cmdecho" ce)

(setvar "blipmode" blp)

(setvar "osmode" osm)

(setvar "orthomode" om)

(setvar "plinewid" plwid)

(clnu)

(setq *error* olderr)

(Princ)

) ;end cloud.lsp

 

(defun clnu (/ num pt)

(setq incr (input_integer "\nEntrer le numéro de révision: " incr))

(setq pt(getpoint"\nDéterminez l'emplacement du symbôle de révision sur le nuage: "))

(command"layer""s""rcloud""")

(command "polygon" "3" pt "I" (/(getvar"dimscale")6.5))

(setvar"cecolor""1")

(command "text" "m" pt (*(getvar"dimscale")(getvar"dimtxt")1.0) "0" (itoa incr))

(setq incr (+ incr 1))

(setvar"cecolor""bylayer")

(command"layer""s"cl"")

)

 

(Defun c:RCHELP (/)

(prompt " The Revision Cloud program draws a user specified bulge pline\n")

(prompt " along the path of the crosshairs. To close the cloud, \n")

(prompt " simply return to the starting point\n")

(prompt " The cloud arc length can be specified in the beginning, with keyboard input\n")

(prompt " by specifying A for Arc, entering a length, or picking two pts.\n")

(textscr)

(princ)

)

 

(Prompt " REVCLOUD chargé. Tapez REVCLOUD pour dessin le nuage de révision,\n")

(prompt " pour fermer le nuage revenez au point de départ. pour de l'aide additionnelle - RCHELP")

(Princ)

 

Le deuxième:

 

;;; PL2Cloud.lsp by Charles Alan Butler

;;; Copyright 2004

;;; by Precision Drafting & Design All Rights Reserved.

;;; Contact at ab2draft@TampaBay.rr.com

;;;

;;; Version 1.0 Beta May 1,2004

;;; Version 1.1 Beta May 5,2004

;;; Added options to size the arc

;;; Version 1.2 Beta May 19,2004

;;; Added option for cloud style

;;; Version 1.3 Beta June 15,2004

;;; Revised to use Dialog Box Interface

;;; Version 1.4 Beta June 23,2004

;;; Dialog Box Revisions

;;; Version 1.5 Beta September 16,2004

;;; Incorperated the Dialog File Creator Routine

;;; Disabled the Chord Length DimScale feature

;;; Version 2.0 October 22,2004

;;; Support for arcs polylines and will also process a picked

;;; spline, circle or ellipse

;;;

;;; DESCRIPTION

;;; User picks or Draws a LW polyline and the routine draws a revision

;;; cloud along it, User option to delete the original polyline

;;;

;;; Files Required to be in the AutoCAD search path

;;; pl2cloud.dcl

;;; rc_normal.sld

;;; rc_shadow.sld

;;; rc_length.sld

;;;

;;; Limitations

;;; No error checking when object pline is too small

;;;

;;;

;;; Command Line Usage

;;; Command: PL2Cloud

;;; Dialog Box is displayed unless there is a problem

;;; Then the command line version is as follows

;;; Enter method to get polyline. [Détermine 2 points / Dessine / Options / Nuage] :

;;; Keep the original polyline [Yes No] :y

;;; Pick Polyline to cloud:

;;;

;;; Options: Command Line Version

;;; Pick - allows user to pick an existing poly line

;;; Draw - allows user to draw a new polyline

;;; Shadow - toggles the shadow effect on/off

;;; Options - Change Arc Angle, makes arcs fatter or thinner

;;; Change the chord length of the arcs

;;; Enter a new Chord length or negative number to divide into DimScale

;;; Enter the actual chord length desired or

;;; enter a negative number and that number will be divided into

;;; the current dimscale to derive the chord length

;;;

;;; This software is provided "as is" without express or implied ;

;;; warranty. All implied warranties of fitness for any particular ;

;;; purpose and of merchantability are hereby disclaimed. ;

;;; You are hereby granted permission to use, copy and modify this ;

;;; software without charge, provided you do so exclusively for ;

;;; your own use or for use by others in your organization in the ;

;;; performance of their normal duties, and provided further that ;

;;; the above copyright notice appears in all copies and both that ;

;;; copyright notice and the limited warranty and restricted rights ;

;;; notice appear in all supporting documentation. ;

 

(prompt "Loading PL2Cloud....")

(defun c:pl2cloud (/ dscale plw dist spcs

usercmd useros *error* a270 a90

userbm oer oldplw ent entlst

oldent method keeppl useds arcang

chord cloud_style draw_style

keeppl

)

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun *error* (msg)

(if

(not

(member

msg

'("console break" "Function cancelled" "quit / exit abort" "")

)

)

(princ (strcat "\nError: " msg))

) ; if

(setvar "Plinewid" oldplw)

(setvar "blipmode" userbm) ;reset blipmode

(setvar "CMDECHO" usercmd)

(setvar "osmode" useros)

(setq pl2cloudglobal (put_saved_vars)

userbm nil

oldplw nil

usercmd nil

useros nil

)

(princ)

) ;end error function

 

;;; =================================================================

;;; Main Routine

;;; =================================================================

(setq usercmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(setq useros (getvar "osmode"))

(setvar "osmode" 0)

(setq userbm (getvar "blipmode"))

(setvar "blipmode" 0)

(setq oldplw (getvar "plinewid")) ;get old Plinewidth setting

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

;; Arc size is determined by the following defaults

;; They remain set throught the session in one drawing

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

;; arcang 140 arc angle, smaller = flatter arcs ; start with 140

;; chord -2 Arc Chord Length > 0 use actual chord distance

;; else < 0 use dim scale / (abs chord)

;; example dimscale = 48 use -1 and chord will be 48 units

;; use -2 and chord will be 24 units

;; cloud_style "Normal" or "Shadow" Pre set cloud style

(if (null pl2cloudglobal)

;; does not exist yet, make global so we can reuse in this drawing

;; these are the default values used the first time run in a session

(setq pl2cloudglobal ; Set Default values

(list 140 ; Model Space ArcAng

140 ; Paper Space ArcAng

-2 ; Model Space Chord

20 ; Paper Space Chord

"Pick" ; draw style Pick or Draw

nil ; Keep poly line T or nil

"Normal"); cloud style Normal or Shadow

)

)

(get_saved_vars)

 

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

;; To Place on layer cloud, color red (1)

;; remove the ;; from the next line

;;(command ".layer" "m" "cloud" "c" "1" "cloud" "")

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(setq dscale (getvar "dimscale")

plw 0 ;(* 0.05 dscale); polyline width

a90 (/ pi 2)

a270 (* pi 1.5)

2pi (* pi 2)

useds chord ; use dimscale flag

)

(setq arcdata (arc_check))

(if (null(and (create_dcl "pl2cloud.dcl")

(run_dialog)))

(run_command_line))

 

;; keep flag in case dimscale is changed

(if useds (setq chord useds))

(*error* "")

(gc)

(princ)

) ;End program

(prompt "\nEntrer PL2Cloud pour démarrer.")

(princ)

;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;

;;; End of main routine

;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;

 

 

 

;;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-

;;; -

;;; Functions -

;;; -

;;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-

 

 

;;-----------------------------------------------------------------

;; Dialog Box - get ready to start the dialog for the first time

;;-----------------------------------------------------------------

(defun run_dialog ()

(setq dcl_id (load_dialog "pl2cloud.dcl"))

(if (new_dialog "pl2cloud" dcl_id)

(progn

(while (= (setq dialog_action (dialog_call)) 2)

(initget 6)

(if (setq

tmp (getdist

(strcat "\nSpecify arc length <" (rtos chord) ">: ")

)

)

(setq chord tmp)

)

(new_dialog "pl2cloud" dcl_id)

) ; while

(if (= dialog_action 1) ; make the cloud

(if (= draw_style "Pick")

(do_pick_method)

(do_draw_method)

)

)

(unload_dialog dcl_id)

T ; return True

) ; progn

(alert "Clould not load pl2cloud.dcl.")

) ; endif

) ; defun run_dialog

 

;;======================================================

;; Dialog Box - Tiles Set Up

;;======================================================

(defun dialog_call (/ rtnval)

 

(setq x (dimx_tile "rc_img")

y (dimy_tile "rc_img")

)

(if (= cloud_style "Normal")

(progn

(start_image "rc_img")

(slide_image 0 0 x y "rc_normal")

(end_image)

(set_tile "rbNormal" "1")

)

(progn

(start_image "rc_img")

(slide_image 0 0 x y "rc_shadow")

(end_image)

(set_tile "rbShadow" "1")

)

)

 

(setq x (dimx_tile "rc_lng_img")

y (dimy_tile "rc_lng_img")

)

 

(start_image "rc_lng_img")

(slide_image 0 0 x y "rc_length")

(end_image)

 

(set_tile "edtLength" (rtos chord))

(if (in_paper_space)

(set_tile "TitleMd" "Vous êtes dans l'Espace Papier, EP valeurs chargées.")

(set_tile "TitleMd" "Vous êtes dans l'Espace Objet, EO valeurs chargées.")

)

(action_tile "rbNormal" "(set_style $key)")

(action_tile "rbShadow" "(set_style $key)")

(action_tile "rc_img" "(set_style $key)")

(action_tile "edtLength" "(get_arc_length $value)")

(action_tile "btnPick" "(done_dialog 2)")

(set_pick draw_style)

(if keeppl

(set_tile "KeepPl" "1")

(set_tile "KeepPl" "0")

)

(action_tile "accept" "(Get_Values)")

;(action_tile "help" "(rc_help)")

 

(setq rtnval (start_dialog))

 

rtnval

) ; defun dialog_call

 

;;======================================================

;; Dialog Box - get vars & exit dialog

;;======================================================

(defun get_values ()

(if (= (get_tile "KeepPl") "1")

(setq keeppl t)

(setq keeppl nil)

)

(if (= (get_tile "radPick") "1")

(setq draw_style "Pick")

(setq draw_style "Draw")

)

(done_dialog 1)

) ; defun get_values

 

;;======================================================

;; Dialog Box - Pline Entry Method Buttons

;;======================================================

(defun set_pick (key)

(if (= key "Pick")

(progn

(set_tile "radPick" "1")

(set_tile "radDraw" "0")

)

(progn

(set_tile "radPick" "0")

(set_tile "radDraw" "1")

)

)

) ; defun set_pick

 

;;======================================================

;; Dialog Box - error check user entered length

;;======================================================

(defun get_arc_length (len / newlen)

(setq len (strcase len)

newlen (distof len)

useds nil ; turn off the DimScale Feature

)

(cond

((or (= len "") (<= newlen 0.0))

(set_tile "error" "Arc length must positive and nonzero.")

)

(t

(set_tile "error" "")

(setq chord (distof len))

(set_tile "edtLength" (rtos chord))

)

) ;cond

) ;defun get_arc_length

 

;;======================================================

;; Dialog Box - Style Buttons

;;======================================================

(defun set_style (key / x y active)

(setq x (dimx_tile "rc_img")

y (dimy_tile "rc_img")

)

(cond

((= key "rbNormal")

(setq active "rc_normal"

cloud_style "Normal"

)

)

((= key "rbShadow")

(setq active "rc_shadow"

cloud_style "Shadow"

)

)

(t

(if (= (get_tile "rbNormal") "1")

(progn

(setq active "rc_shadow"

cloud_style "Shadow"

)

(set_tile "rbShadow" "1")

)

(progn

(setq active "rc_normal"

cloud_style "Normal"

)

(set_tile "rbNormal" "1")

)

)

)

)

 

(start_image "rc_img")

(fill_image 0 0 x y 0)

(slide_image 0 0 x y active)

(end_image)

) ; defun set_style

 

;;==================================================================

;; this code is used if there is a problem with the dialog box code

;;==================================================================

(defun run_command_line ()

;; Get type of polyline input

(prompt "\nDessine nuage de révision à partir d'une polyligne.")

(while (null method)

(initget "Pick Draw Options Shadow")

(setq method

(getkword

(strcat

"\nEntrer méthode pour obtenir polyligne. "

"[Pick / Dessine / Options / Nuage] (ArcAng="

arcdata

") :"

)

)

)

(cond

((= method "Options") ; set arc angle, chord length, Pline width

(get_options)

(setq arcdata (arc_check))

(setq method nil) ; stay in loop

)

((= method "Shadow")

(if (= cloud_style "Normal")

(setq cloud_style "Shadow")

(setq cloud_style "Normal")

)

(prompt (strcat "Cloud Style changed to " cloud_style))

(setq method nil) ; stay in loop

)

((null method) (setq method "Pick")) ; nil default to pick

) ; end cond stmt

) ; end while

(initget "Yes No")

(setq keeppl (getkword "\nKeep the original polyline [Yes No] :"))

(if (null keeppl)

(setq keeppl "No")

)

 

(cond

((= method "Pick") (do_pick_method))

((= method "Draw") (do_draw_method))

) ; end cond stmt

) ; end defun run_command_line

;;==================================================================

 

;;======================================================

;; Allow user to pick a pline

;;======================================================

(defun do_pick_method ()

(if (setq ent (entsel "\nSélectionnez la Polyligne pour dessiner le Nuage: "))

(if

(member (cdr (assoc 0 (setq entlst (entget (car ent)))))

'("LWPOLYLINE" "SPLINE" "CIRCLE" "ELLIPSE"))

(progn

(makecloud entlst)

(if (or (= keeppl "No") (= keeppl nil))

(entdel (car ent))

)

)

(prompt "\nError - Not a LWpolyline.")

) ; endif

) ; endif

) ; end defun do_pick_method

 

;;======================================================

;; Allow user to draw a pline

;;======================================================

(defun do_draw_method ()

(prompt

"\nDessine la polyligne, C ferme la polyligne ou Entrer lorsque terminé."

)

(setq oldent (entlast))

(command "_.pline")

;; repeat a point input until Enter

(while (> (getvar "CMDACTIVE") 0)

(command pause)

)

(setq ent (entlast))

(if (null (eq ent oldent))

(makecloud (entget ent))

) ; endif

(if (or (= keeppl "No") (= keeppl nil))

(entdel ent)

)

) ; end defun do_draw_method

 

;;======================================================

;; get variables stored in list

;;======================================================

(defun get_saved_vars ()

(if (in_paper_space); get paperspace vars

(setq arcang (nth 1 pl2cloudglobal)

chord (nth 3 pl2cloudglobal)

)

;; else get model space vars

(setq arcang (nth 0 pl2cloudglobal)

chord (nth 2 pl2cloudglobal)

)

)

;; get other user preferences

(setq draw_style (nth 4 pl2cloudglobal))

(setq keeppl (nth 5 pl2cloudglobal))

(setq cloud_style (nth 6 pl2cloudglobal))

); defun get_saved_vars

 

;;======================================================

;; save variables in a global variable list

;;======================================================

(defun put_saved_vars ()

(if (in_paper_space); save paperspace vars

(setq pl2cloudglobal

(list

(nth 0 pl2cloudglobal)

(abs arcang)

(nth 2 pl2cloudglobal)

chord

draw_style

keeppl

cloud_style

)

)

;; else save model space vars

(setq pl2cloudglobal

(list

(abs arcang)

(nth 1 pl2cloudglobal)

chord

(nth 3 pl2cloudglobal)

draw_style

keeppl

cloud_style

)

)

)

); defun put_saved_vars

 

;;==================================================================

;; Test Title Mode returns T when in PS & Viewports are closed

;;==================================================================

(defun in_paper_space ()

(and (= (getvar "tilemode") 0) ;In PS

(= (getvar "cvport") 1) ; Vps Closed

)

); defun in_paper_space

 

;;======================================================

;; routine to make the actual polyline cloud

;;======================================================

(defun makecloud (elst / pvl len closed loop pt1 p1 p2 ang

divDist endParam totLen dist)

;;-----------------------------------------------------------------

;; <<< get points along an object >>>

;;-----------------------------------------------------------------

;; n is the number of intervals

;; e is the entity name

;; returns a list of points

(vl-load-com)

(setq dist 0.0)

(setq obj (cdr (assoc -1 elst))

endParam (vlax-curve-getEndParam obj)

totLen (vlax-curve-getDistAtParam obj endParam)

)

 

;; set arc distance and number of arc in segment

;; Arc chord length set to aprox

(setq spcs (/ totlen chord)) ;Arc spacing

(setq spcs (fix (+ 0.999 spcs))) ; round up

(setq spcs (max 2 spcs)) ;min of 2 spaces

(setq divDist (/ totlen spcs)) ;set arc distances

 

(while (<= dist totLen)

(setq pvl (cons (vlax-curve-getPointAtDist obj dist) pvl)

dist (+ dist divDist)

)

)

(setq pvl (reverse (cons

(vlax-curve-getPointAtParam obj endParam) pvl)))

 

 

;; ??? may not need

;(if ; true if closed

; (setq closed (eq 1 (logand 1 (cdr (assoc 70 elst)))))

;; Closed pline, so add the 5th point

; (setq pvl (reverse (cons (car pvl) (reverse pvl))))

;)

 

 

(if (= (@polydir pvl) "CW")

(setq arcang (- arcang)) ; Arc Angle

)

;; start polyline command with width and arc mode

(command "PLINE" (car pvl) "W" plw "" "_A")

(foreach pt pvl ;draw side segments

(if (= cloud_style "Shadow")

(command "_w" "0" (* chord 0.10))

)

(command "_A" arcang pt)

)

;;----------------------------------------------------

(if closed

(command "CL") ;Close polyline

(command "")

)

) ; end defun makecloud

 

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

;; Get Cloud Arc Options

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

;; used by command line version

(defun get_options (/ loop newang newcd)

(prompt "\nOptions to set Arc Angle and Chord Length.")

;; get arc angle -----------------------------------

(setq loop t)

(while loop

(initget 6)

(setq newang

(getint

(strcat "\nEntrer l'angle du nouvel arc (90 @ 175 deg) <"

(itoa arcang)

"> :"

)

)

)

(cond

((null newang) ; leave angle as is

(setq loop nil)

)

((or (< newang 90) (> newang 175))

(alert "\nAngle out of range. Entrer entre 90 et 175")

)

((setq arcang newang) ; set new angle

(setq loop nil)

)

) ; end cond stmt

) ; end while

 

;; get chord length ------------------------------

(setq loop t)

(while loop

(initget 2)

(setq newcd

(getreal

(strcat "\nEnter a new Chord length or negative "

"number to divide into DimScale <"

(rtos chord 2 2)

"> :"

)

)

)

(cond

((null newcd) ; leave as is

(setq loop nil)

)

((or (< newcd -5) (> newcd 500))

(alert "\nAngle out of range. Entrez entre -5 et 500")

)

((setq chord newcd) ; set new angle

(if (< chord 0)

(setq useds chord) ; save flag

(setq useds nil) ; clear flag

)

(setq loop nil)

)

) ; end cond stmt

) ; end while

 

;; get pline width ------------------------------

) ; end defun get_options

 

 

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

;; Check Arc Data

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun arc_check ()

;; error check arc data

(if (= (type arcang) "REAL")

(setq arcang (fix arcang)) ; make integer

)

(setq arcang (max 90 (min 175 arcang))) ; 90 <= ArcAng <= 175

(setq chord (if (= chord 0) -2 chord)) ; trap 0 only

(if (< chord 0)

;; arc chord length set to (/ dist (dimscale / chord))

(setq useds chord ; save flag

chord (/ dscale (abs chord))

)

;; ELSE

(setq useds nil) ; clear flag

)

(strcat (rtos arcang 2 0) " Length=" (rtos chord 2 2))

) ; end defun arc_check

 

 

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

;; return the list of vertex in pairs

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun vert_lst (el / pvl)

(setq pvl '())

(while (setq el (member (assoc 10 el) el))

(setq pvl (cons (cdar el) pvl)

el (cdr el))

)

pvl

) ; end defun

 

 

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

;; Return the direction of a lwpline

;; Modified form of

;; PolyDir.LSP v1.0 (03-05-02) John F. Uhden, Cadlantic

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun @polydir (coords / i p1 p2 p3 sum)

(setq i 1

sum 0.0

)

(repeat (- (length coords) 2)

(setq p1 (nth (1- i) coords)

p2 (nth i coords)

i (1+ i)

p3 (nth i coords)

sum (+ sum (@delta (angle p1 p2) (angle p2 p3)))

)

)

(if (minusp sum) "CW" "CCW")

) ; end defun

 

;;-----------------------------------------------------------------------

;; This function returns the deflection angle (in radians) of two angles:

;;-----------------------------------------------------------------------

(defun @delta (a1 a2)

(cond

((> a1 (+ a2 pi)) (setq a2 (+ a2 2pi)))

((> a2 (+ a1 pi)) (setq a1 (+ a1 2pi)))

)

(- a2 a1)

) ; end defun

 

 

;; ***************************************************

;; create_dcl function to create a dcl support

;; file if it does not exist

;; Usage : (create_dcl "file name")

;; Returns : T if successful else nil

;; ***************************************************

(defun create_dcl (fname / acadfn)

;;=======================================

;; check revision date Routine

;;=======================================

(defun dcl-rev-check (fn / rvdate ln lp)

;; revision flag must match exactly and must

;; begin with //

(setq rvflag "// Révision Control 10/22/2004@09:17" )

(if (setq fn (findfile fn))

(progn ; check rev date

(setq lp 5) ; read 4 lines

(setq fn (open fn "r")) ; open file for reading

(while (> (setq lp (1- lp)) 0)

(setq ln (read-line fn)) ; get a line from file

(if (vl-string-search rvflag ln)

(setq lp 0)

)

) ; end while

(close fn) ; close the open file handle

(if (= lp -1)

nil ; no new dcl needed

t ; flag to create new file

)

) ; end progn

t ; flag to create new file

) ; endif

) ; defun

(if (null(wcmatch (strcase fname) "*`.DCL"))

(setq fname (strcat fname ".DCL"))

)

(if (dcl-rev-check fname)

;; create dcl file in same directory as AutoCAD.PAT

(progn

(setq acadfn (findfile "ACAD.PAT")

fn (strcat (substr acadfn 1 (- (strlen acadfn) 8))fname)

fn (open fn "w")

)

(foreach x (list

"// WARNING file will be recreated if you change the next line"

rvflag

"//PL2cloud.dcl"

"//"

""

"pl2cloud : dialog {"

" label = \"PL2Cloud - Révision Nuage Options Rev 2.0 - Par CAB\" ;"

" spacer_1 ;"

" : text { label = \"Sélectionne ou dessine une polyligne crée un nuage de révision.\";"

" key = \"t1\";"

" }"

" : text { key = \"TitleMd\" ;"

" }"

" spacer_1 ;"

""

" : boxed_row {"

" label = \"Arc Style\" ;"

" : image_button {"

" color = 0 ;"

" aspect_ratio = 0.8 ;"

" fixed_width = true ;"

" width = 11 ;"

" key = \"rc_img\" ;"

" }"

" : radio_column {"

" spacer_0 ;"

" : radio_button {"

" key = \"rbNormal\" ;"

" label = \"Normal\" ;"

" mnemonic = \"N\" ;"

" }"

" : radio_button {"

" key = \"rbShadow\" ;"

" label = \"Nuage\" ;"

" mnemonic = \"S\" ;"

" }"

" spacer_0 ;"

" }"

" spacer_1 ;"

" }"

" spacer_1 ;"

" : boxed_row {"

" label = \"Arc Longueur de la corde\" ;"

" : image {"

" aspect_ratio = 0.8 ;"

" color = 0 ;"

" fixed_width = true ;"

" key = \"rc_lng_img\" ;"

" width = 11 ;"

" }"

" : column {"

" : edit_box {"

" label = \"Corde Longueur\" ;"

" key = \"edtLength\" ;"

" fixed_width = true ;"

" edit_width = 6 ;"

" }"

" : button {"

" fixed_width = true ;"

" key = \"btnPick\" ;"

" label = \"Détermine 2 points <\" ;"

" // mnemonic = \"P\" ;"

" width = 4 ;"

" }"

" }"

" }"

" "

" "

" "

" spacer_1 ;"

" : boxed_row {"

" label = \"Options\" ;"

" : radio_column {"

" spacer_0 ;"

" : radio_button {"

" key = \"radPick\" ;"

" label = \"Sélectionner polyligne existante\" ;"

" mnemonic = \"P\" ;"

" }"

" : radio_button {"

" key = \"radDraw\" ;"

" label = \"Dessiner une nouvelle polyligne\" ;"

" mnemonic = \"D\" ;"

" }"

" spacer_0 ;"

" }"

" : toggle { "

" key = \"KeepPl\"; "

" label = \"Extérieur polyligne\"; "

" } "

""

" }"

" spacer_1 ;"

""

" ok_cancel_err ;"

"}"

) ; endlist

(princ x fn)

(write-line "" fn)

) ; end foreach

(close fn)

(setq acadfn nil)

(alert (strcat "\nDCL file created, please restart the routine"

"\n again if an error occures."))

t ; return True, file created

) ; end progn

t ; return True, file found

) ; endif

) ; end defun

 

 

;;;***********************************

;;; -=< End Of File >=-

;;;***********************************

 

ce dernier programme est complété par 3 fichiers (rc_normal.sld, rc_shadow.sld et rc_lenght.sld) dont je ne sais comment les joindre au message.

 

 

 

:P

[Tramber]

Use, duplication, or disclosure by the U.S. Government is subject to

restrictions set forth in FAR 52.227-19 (Commercial Computer

Software - Restricted Rights) and DFAR 252.227-7013©(1)(ii)

(Rights in Technical Data and Computer Software), as applicable.

 

avec 2000 i et 2002 le menu était payant...

 

Plus maintenant on dirait ;)