Lisp for drafting welded 'T' profile

miroko · ‎10-13-2015

Hello,

People at office would like to have a lisp which will draw a ‘T’ welded profile. This ‘T’ is really simple profile, example attached.

Could you help on that one?

Would be great if lisp would do following after command is started:

1. After command is started a dialog box is appearing saying: ‘’Specify web height’’.

(see attached dwg file where I just pasted the dialog box as screenshot). BTW. this dialog box was used already in other lisps which I got help with at this forum, links here:
http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/renamepastedblock/m-p/5606863
http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/pasteundernewname-block/m-p/5611344

2. Then user write dimension and click ‘OK’

if user accidentally write non-digit like '12w' then lisp could warn, i.e. ''Incorrect input, specify digit'')

3. Next dialog box appear: ‘’Specify web thickness’’

4. Then user write dimension and click ‘OK’

5. Next dialog box appear: ‘’Specify flange width’’

6. Then user write dimension and click ‘OK’

7. Next dialog box appear: ‘’Specify flange thickness’’

8. Then user write dimension and click ‘OK’

9. Then lisp create block with name ‘’T-WEB.nxn-FL.nxn’’, where ‘n’ are dimensions given in earlier steps. Example T-WEB.300x10-FL.200x15 (but it does not insert it yet). If block with that name already exist then info window appear: ''Such profile was already defined in the drawing, inserting defined earlier block''.

10. Window appearing on screen with message: ‘’Specify insertion point’’

11. User click ‘OK’ and then user have to click on screen to show insertion point.

12. Lisp insert this block at the insertion point (at current layer)

If block with that name already exist then just inserts the already defined block.

I tried to make it using actions in the AutoCAD but always was something missing or not fully correct. And additionally since the T profile alone is just beginning, as they also like to have lisp for T-profile with some ‘passages’, then ‘actions’ are actually out of question. I hope it is not too time consuming or complicated for a lisp.

I would very much appreciate if someone could help with the lisp above, the other ones would be ‘next step’, if you would find time (thinking would be total 4 lisps).

Attached dwg shows also the T 'orientation' (flange at the bottom).

Regards

miroko

Kent1Cooper · ‎10-14-2015

I'm not experienced with making dialog boxes, but if you want to use that approach, couldn't there be one dialog box asking for all four pieces of information? Otherwise, I don't see any advantage over just asking for input at the Command: prompt.

And it looks like what you pasted in isn't a real dialog box, but merely a (lisped) function. [That I could do, but see below.]

I do see actual advantages to using Command:-line prompts instead:

A. Using (getdist) in such a prompt, the User has the option of giving a dimension by picking two points on-screen. [Even if a dialog box can be set up so you can do that, it would be an extra step to pick on a pick-on-screen button to get there. But it's not a possibility at all with (lisped).]

B. It would save a step in specifying the insertion point, because the User would do it immediately and directly, without needing to pick OK first.

C. If you're getting input via (lisped) functions, all of it will be text strings, which will then need to be converted to numerical values. But if you prompt for input with (getdist) or (getreal) functions, no conversion will be required, and with (getdist), they can enter values in various formats, such as including feet and/or fractions [though maybe that's not an issue in your situation, given your Block name format].

If the Command:-line approach would work for you, I think this would not be a difficult routine to build.

Kent Cooper, AIA

Kent1Cooper · ‎10-14-2015

@Kent1Cooper wrote:

....

A. Using (getdist) in such a prompt, the User has the option of giving a dimension by picking two points on-screen. ....

If the Command:-line approach would work for you, I think this would not be a difficult routine to build.

Another advantage of (getdist) [in A. above] is that it has built into it the forbidding of invalid input -- if you type in your sample invalid size of "12w," it will ask you again for a numeric distance or two points until you give it a valid input.

Here's a bare-bones version [no error handling, command-echo suppression, Undo begin/end, etc.]:

(defun C:TWF ; = T block defined by Web and Flange sizes
  (/ wh wt fw ft pt blk web)
  (setq
    wh (getdist "\nWeb height: ")
    wt (getdist "\nWeb thickness: ")
    fw (getdist "\nFlange width: ")
    ft (getdist "\nFlange thickness: ")
    pt (getvar 'viewctr)
    blk (strcat "T-WEB." (rtos wh 2 0) "x" (rtos wt 2 0) "-FL." (rtos fw 2 0) "x" (rtos ft 2 0))
  ); setq
  (if (not (tblsearch "block" blk))
    (progn ; then
      (command "_.rectangle" "_none" (polar pt pi (/ wt 2)) "_none" (mapcar '+ pt (list (/ wt 2) wh 0)))
      (setq web (entlast))
      (command
        "_.rectangle" "_none" (polar pt 0 (/ fw 2)) "_none" (mapcar '- pt (list (/ fw 2) ft 0))
        "_.block" blk "_none" (mapcar '+ pt (list (/ wt -2) wh 0)) web (entlast) ""
      ); command
    ); progn
  ); if
  (command "_.insert" blk "_rotate" 0 "_scale" 1)
); defun

Note that it builds the Block definition in relation to the middle of the screen, and doesn't ask for an insertion point until after it has gotten sizes, and has either found or defined a Block, so you can see it as you drag it into position, whether or not a Block with that name already exists before you start.

If you should type in or pick on-screen distances that are not whole-number values, it rounds them to the nearest whole number in the Block name, though it uses them as specified [un-rounded] in the drawing of the T. If you want to limit it to whole number values entirely, you could use (getint) instead of (getdist), but you don't get the option of picking two points on-screen that way. You could even have it restrict values to not just integers, but multiples of some integer value such as 5, if that's typical of the T's you work with.

Kent Cooper, AIA

miroko · ‎10-14-2015

Hello

Thank you for looking at the subject.

You are indeed correct that single dialog box would be much better than many times single dialog box. I did not know that this may be possible so was basing on previous ‘boxes’… I did not know also that ‘lisped’ value need to be converted to digits so of course it would just complicate the lisp.

Regarding the command line version.

Picking the dimension on screen would not be used by our users since they never do that when drafting this kind of object. I mean that they never fill-in some gaps between other objects where such dimension could be foubd/defined. They just draw two rectangles by RECTANGLE command and give direct dimensions (i.e. 200 then 20).

The routine which you made is working. The only thing which is not best is the option for picking size on screen. The users will be confused in beginning and they will always in a way ‘automatically’ pick point on screen thinking that this is insertion point and then it will start going wrong - especially that the cursor is changing to the picking-point-cross so I am sure they will click on screen, I did that actually as well :). Best would be to block that functionality, I mean that if user indeed pick on screen then command will repeat the question i.e. ‘specify web thickness’.

Ps. I just have shown this routine to two colleagues and they were very happy so I think we can go for the command line version.

There is only one thing which I did not foresee... It is actually the layers. We have already other 'blocks' in library and they are built such that the block is inserted on layer 200-CO2 (color yellow, linetype continues). The 'T' itself we would put on layer 0 (inside block), but the block itself we place on layer 200-CO2. When layer not exist would need to be created. Would that not be too much for adding to routine?

Similar layer functionality was used here:

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-insert-purge-and-draw-multili...

regards

miroko

Kent1Cooper · ‎10-15-2015

miroko wrote:

.... The only thing which is not best is the option for picking size on screen. .... Best would be to block that functionality....

For that change, if you always use whole-number values, simply replace the word getdist with getint in four places, and wherever a dimension is divided by 2 [positive or negative], replace the 2 with 2.0 -- (/ wt 2.0) twice, (/ fw 2.0) twice, and (/ wt -2.0) once.

If you might ever use values with decimal places, use getreal instead. But that raises the question of how the Blocks should be named....

Kent Cooper, AIA

Kent1Cooper · ‎10-15-2015

@miroko wrote:

... the layers. We have already other 'blocks' in library and they are built such that the block is inserted on layer 200-CO2 (color yellow, linetype continues). The 'T' itself we would put on layer 0 (inside block), but the block itself we place on layer 200-CO2. When layer not exist would need to be created. Would that not be too much for adding to routine?

....

That's a very common ingredient in routines like this. Here's one way to do that, also incorporating the (getint)-related changes:

(defun C:TWF ; = T block defined by Web and Flange sizes
  (/ svnames svvals clay wh wt fw ft pt blk web)
  (setq
    svnames '(cmdecho osmode blipmode); System Variable Names
    svvals (mapcar 'getvar svnames); their initial Values
    clay (getvar 'clayer); separately from svnames
    wh (getint "\nWeb height: ")
    wt (getint "\nWeb thickness: ")
    fw (getint "\nFlange width: ")
    ft (getint "\nFlange thickness: ")
    pt (getvar 'viewctr)
    blk (strcat "T-WEB." (rtos wh 2 0) "x" (rtos wt 2 0) "-FL." (rtos fw 2 0) "x" (rtos ft 2 0))
  ); setq
  (if (not (tblsearch "block" blk)); not yet defined
    (progn ; then
      (mapcar 'setvar svnames '(0 0 0))
      (setvar 'clayer "0")
      (command "_.rectangle" (polar pt pi (/ wt 2.0)) (mapcar '+ pt (list (/ wt 2.0) wh 0)))
      (setq web (entlast)); [for selection in Block definition]
      (command
        "_.rectangle" (polar pt 0 (/ fw 2.0)) (mapcar '- pt (list (/ fw 2.0) ft 0))
        "_.block" blk (mapcar '+ pt (list (/ wt -2.0) wh 0)) web (entlast) ""
      ); command
    ); progn
  ); if
  (command "_.layer" "_make" "200-CO2" "_color" 2 "" "")
    ; becomes current in the process; doesn't matter whether it already exists
  (mapcar 'setvar svnames svvals); reset all but Layer
  (command  "_.insert" blk "_rotate" 0 "_scale" 1); leaves dragging at insertion-point prompt
  (while (> (getvar 'cmdactive) 0) (command pause)); wait for completion, after which:
  (setvar 'clayer clay); reset Layer
); defun

That way of doing the Insert allows the User to call for options such as a different Rotation [which will override the one it starts with], if they want. I assume you never use them at scale factors other than 1, but if you also never use them at rotations other than with the flange at the bottom, you could replace this part:

(command "_.insert" blk "_rotate" 0 "_scale" 1)
(while (> (getvar 'cmdactive) 0) (command pause))

with just this, leaving only the insertion point for the User to specify before it resets the Layer:

(command "_.insert" blk "_rotate" 0 "_scale" 1 pause)

But that leaves the possibility [however remote] that a User will type in an option at that pause, which would throw things off because there's no allowance for any more inputs to the Insert command after that.

It could still use an *error* handler to reset the current Layer if the User cancels during the Insert command. And if you like, it could also be made to remember your size choices and offer them as defaults the next time you use it, but that involves a fair amount more code.

Kent Cooper, AIA

miroko · ‎10-15-2015

Hello,

This lisp works great !!

I tried to do one more thing self but did not manage.

It is about going to previous layer when command is apparently 'cancelled' by user (after all dimensions are already specified).

When I specify all dimensions and then press 'Escape' then it does not go back to previous layer but remains on 200-CO2.

I tried to use part of code from here:

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-insert-purge-and-draw-multili...

(the orange part from post number 7) but am getting errors at function start.

Would this be possible in here?

EDIT:

I think we do not need functionality that it will remember last sizes choices. This may become too complicated.

regards

miroko

Kent1Cooper · ‎10-15-2015

@miroko wrote:

Hello,

This lisp works great !!

I tried to do one more thing ... about going to previous layer when command is apparently 'cancelled' by user (after all dimensions are already specified).

When I specify all dimensions and then press 'Escape' then it does not go back to previous layer but remains on 200-CO2.

....

You may have not put it in just the right place, or something. [It doesn't need the (setvar 'cmdecho cmde) in this case, which would give you an error message because that variable name is not used, but that shouldn't stop it from resetting the Layer.]

I'd ask to see your version, but what the heck.... This way works for me:

(defun C:TWF ; = T block defined by Web and Flange sizes
  (/ *error* svnames svvals clay wh wt fw ft pt blk web)
  (defun *error* (errmsg); error handler
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (prompt (strcat "\nError: " errmsg))
    ); if
    (setvar 'clayer clay)
  ); defun -- *error*
  (setq
    svnames '(cmdecho osmode blipmode); System Variable Names
    svvals (mapcar 'getvar svnames); their initial Values
    clay (getvar 'clayer); separately from svnames
    wh (getint "\nWeb height: ")
    wt (getint "\nWeb thickness: ")
    fw (getint "\nFlange width: ")
    ft (getint "\nFlange thickness: ")
    pt (getvar 'viewctr)
    blk (strcat "T-WEB." (rtos wh 2 0) "x" (rtos wt 2 0) "-FL." (rtos fw 2 0) "x" (rtos ft 2 0))
  ); setq
  (if (not (tblsearch "block" blk)); not yet defined
    (progn ; then
      (mapcar 'setvar svnames '(0 0 0))
      (setvar 'clayer "0")
      (command "_.rectangle" (polar pt pi (/ wt 2.0)) (mapcar '+ pt (list (/ wt 2.0) wh 0)))
      (setq web (entlast)); [for selection in Block definition]
      (command
        "_.rectangle" (polar pt 0 (/ fw 2.0)) (mapcar '- pt (list (/ fw 2.0) ft 0))
        "_.block" blk (mapcar '+ pt (list (/ wt -2.0) wh 0)) web (entlast) ""
      ); command
    ); progn
  ); if
  (command "_.layer" "_make" "200-CO2" "_color" 2 "" "")
  (mapcar 'setvar svnames svvals); reset all but Layer
  (command  "_.insert" blk "_rotate" 0 "_scale" 1)
; or, in place of line above, use
;  (command  "_.insert" blk "_rotate" 0 "_scale" 1 pause)
; and remove line below
  (while (> (getvar 'cmdactive) 0) (command pause))
  (setvar 'clayer clay); reset Layer
); defun

Kent Cooper, AIA

miroko · ‎10-16-2015

Hi

It is working nice !

Thank you !

Many people will be happy.

I hope you may help in the three remaining lisps (as mentioned in first post)... They may be more complicated though...

Only dont know if to open new thread, it is about the same T profile but with passages as in attachment.

The passage itself we place on a separate layer, otherwise the principles are the same.

People use lot of time to draw this passages every time, quite time consuming.

regards

miroko

stevor · ‎10-16-2015

To save time, some additional methods have been used:
1. Separate routines for often used constructions.
2 Default dimensions for the user input
3. Filter user dimension input to allowed sizes.

S

Kent1Cooper · ‎10-16-2015

@miroko wrote:

....

It is working nice !

Thank you !

....

I hope you may help in the three remaining lisps (as mentioned in first post)...

....

You're welcome. [Does it qualify as a Solution, or would you rather wait to work out the other stuff?]

Some questions:

Just so I understand -- what does the "NON" part represent? And what are the "passages"?

Would you mind changing the standard format of some of the Block names?

A) In the plain T, you have WEB before the web dimensions, but in the others, you have WT. Does the WT have something to do with having the passages and/or lug included, as opposed to WEB for Blocks without either of those, or could they both be the same?

B) In one, you have -LUG between the WT abbreviation and the web dimensions. I think it would be easier to make a sort of "universal" approach [one AutoLisp file containing multiple commands or a command with options (see below), sharing some common sub-routines] if the web & flange abbreviations & sizes were always in a consistent group at the same location [whether at the end or elsewhere] in the Block name, and if in that case the -LUG part of the name could come before [or possibly after] that group of size indications.

C) They all begin with T-WEB, but in the plain-T one that WEB is followed immediately by the web sizes, whereas in the others there's more in between, including a different abbreviation apparently related to the web. Is the -WEB part needed at all in those other Block names, if the difference between WEB and WT distinguishes the plain-T Block from the others?

D) I think I would be inclined to name all Blocks starting with the T- and the web & flange abbreviations & sizes, followed by any indications of passages and/or lug, so that in the Insert command dialog box, the listing would have all the options for the same size T grouped together. But maybe you want all the passages options together, all the lug options together, etc.

Would it be better to have one command that asks the User whether they want the passages and/or lug as options, or separate commands for each kind?

And I would also be inclined to have the insertion point at the midpoint of that top edge [or the bottom face], rather than at the corner, because [for example] it would make it easier to place on a column center-line or the like.

Kent Cooper, AIA

miroko · ‎10-16-2015

Hello

Those are passages of a stiffener (the welded T profile) through a steel wall.

A/B/C

I see that I messed a bit the names, you are correct. Attached fixed file. The part of name which is in example:

WEB.300x10-FL.200x15

will always be the same.

The only difference will be that beginning of name will be one of below (depending on what user have selected):

T- – for plain T. Example: T-WEB.300x10-FL.200x15
T-NON-WT- – for NON-WaterTight passage. Example T-NON-WT-WEB.300x10-FL.200x15
T-NON-WT-LUG- – for NON-WaterTight passage with LUG (rectangle steel bracket). Example: T-NON-WT-LUG-WEB.300x10-FL.200x15
T-WT- – for WaterTight passage. Example: T-WT-WEB.300x10-FL.200x15

In attached dwg I also included small descriptive text showing the plain-T name versus new-T blocks names.

C

We are basing a lot on tool palettes. Our idea is to have four separate icons on that palette. Each of them will have a picture of the T (one icon for 'T alone', one for 'T with non-wt passage', one for 'T with non-wt passage+lug' and one for 'T with watertight passage').

Therefore ideally it would need to be a separate commands (without options in command line asking if user want plain-T or other T-block: user will decide that by clicking on a dedicated icon), however the commands can be in the same lisp file (just to avoid few files – but this is not that critical).

Ps. It of course qualify as ‘Solution’. The only thing is that the new T (with passages) are basically the same principle/subject therefore I was bit sceptic to divide posts.

regards

miroko

Kent1Cooper · ‎10-16-2015

With some twiddling around.... Try the attached, which seems to work for me in limited testing. You can change the command names if some other shorthand would be more meaningful to you.

Kent Cooper, AIA

miroko · ‎10-19-2015

wow

wow wow wow

🙂

it is working nicely.

Thank you very much.

I will implement this into our palettes soon.

People will go crazy 😉

regards

miroko

miroko · ‎11-08-2017

Hello

Refreshing bit subject from some time ago.

People are happy with the lisp that @Kent1Cooper created but they are missing one thing which I was hoping to get help with.

The last command in this lisp is:

TwfL ; = T block with non-watertight passage & Lug

It ic creating the T profile with lug on one side.

I tried to add one more version to the lisp that would be making the same, but with two symmetrical lugs.

Tried to implement one more 'draw lug' on the other side but not managed.

Here is original command from attached lisp.

Could you help in writing how to add symmetrical lug?

(defun C:TwfL ; = T block with non-watertight passage & Lug
(/ *error* svnames svvals clay wh wt fw ft pt tblk tins psg)
(twfstart)
(setq tLblk (strcat "T-NON-WT-LUG" (substr tblk 2)))
(if (not (tblsearch "block" tLblk)); not yet defined
    (progn ; then
      (setvar 'clayer "200-CO2")
      (command "_.insert" tblk pt "" "" "")
      (setq tins (entlast))
      (psg1); passage edge
      (setq psg (entlast))
      (command ; draw lug
        "_.rectangle"
          (mapcar '+ pt (list wt -30 0))
          (mapcar '+ pt (list (+ (/ (+ wt fw) 2.0) 70) (- 30 wh) 0))
        "_.block" tLblk pt tins psg (entlast) ""
      ); command
    ); progn
); if
(twfend tLblk)
); defu

regards

miroko

Kent1Cooper · ‎11-08-2017

@miroko wrote:

....

It ic creating the T profile with lug on one side.

I tried to add one more version to the lisp that would be making the same, but with two symmetrical lugs.

Tried to implement one more 'draw lug' on the other side but not managed.

....

Could you help in writing how to add symmetrical lug?

....

Can you post an image or sample drawing showing what it draws for a single lug, and what you want it to do to add the other one?

Kent Cooper, AIA

miroko · ‎11-09-2017

Yes, of course.

Please find attached drawing.

(for some reason i could not attach dwg, had to zip it)

Kent1Cooper · ‎11-09-2017

If 'pt' is the middle of the web thickness [as it was in my original, but I'm not sure about that here, because I would expect the first occurrence of wt in there to be (/ wt 2), but I haven't dug through the entire code], you should be able to simply add to this (command) function:

....

      (command ; draw lug
        "_.rectangle"
          (mapcar '+ pt (list wt -30 0))
          (mapcar '+ pt (list (+ (/ (+ wt fw) 2.0) 70) (- 30 wh) 0))

"_.mirror" "_last" "" pt "@0,1" ""
"_.block" tLblk pt tins psg "_previous" (entlast) ""
); command

....

But if 'pt' has been moved to make the first lug work as it appears, compensation could be made for defining the Mirror axis where it needs to be.

Kent Cooper, AIA

miroko · ‎11-10-2017

Hello

After creating new function and adding new strings to code I get the following result as on atatched picture.

So there is something about mirror axis position. The axis position is not set in middle of web thickness but in the corner resulting in lug being offset.

I did not do any changes in the original code.

When I change the first ocurence of wt to (/ wt 2) then command is a bit collapsing. It starts asking me for redefining block (even though this block does not exist), something about annotation scales, etc. and drafting two small rectangles. So I think that first 'wt' need not be changed but just axis position defined slightly different. Could you take a look?

(defun C:TwfL2 ; = T block with non-watertight passage & two Lugs
(/ *error* svnames svvals clay wh wt fw ft pt tblk tins psg)
(twfstart)
(setq tLblk (strcat "T-NON-WT-TWO-LUGS" (substr tblk 2)))
(if (not (tblsearch "block" tLblk)); not yet defined
    (progn ; then
      (setvar 'clayer "200-CO2")
      (command "_.insert" tblk pt "" "" "")
      (setq tins (entlast))
      (psg1); passage edge
      (setq psg (entlast))
      (command ; draw lug
        "_.rectangle"
          (mapcar '+ pt (list wt -30 0))
          (mapcar '+ pt (list (+ (/ (+ wt fw) 2.0) 70) (- 30 wh) 0))
          "_.mirror" "_last" "" pt "@0,1" ""
        "_.block" tLblk pt tins psg "_previous" (entlast) ""
      ); command
    ); progn
); if
(twfend tLblk)
); defun

CADaSchtroumpf · ‎11-10-2017

Hello,

Just to make a suggestion development.
For example you can use a data table to define your profile type within the lisp
Example IPN this program based on French standards -> poutrelles NF

The result will be an IPN 3D

Try the code to see if that little give you ideas.

(defun c:IPN ( / IPE_data IPEA_data HEA_data HEB_data HEM_data PA_data
                sv_mnu typ_ipn l_data l_str model_ipn unit_key unit_draw l_val pt_ins h b a e r
                po p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16)
(setq
  IPE_data
    '(
       (80 . (80.0 46.0 3.8 5.2 5.0))
      (100 . (100.0 55.0 4.1 5.7 7.0))
      (120 . (120.0 64.0 4.4 6.3 7.0))
      (140 . (140.0 73.0 4.7 6.9 7.0))
      (160 . (160.0 82.0 5.0 7.4 9.0))
      (180 . (180.0 91.0 5.3 8.0 9.0))
      (200 . (200.0 100.0 5.6 8.5 12.0))
      (220 . (220.0 110.0 5.9 9.2 12.0))
      (240 . (240.0 120.0 6.2 9.8 15.0))
      (270 . (270.0 135.0 6.6 10.2 15.0))
      (300 . (300.0 150.0 7.1 10.7 15.0))
      (330 . (330.0 160.0 7.5 11.5 18.0))
      (360 . (360.0 170.0 8.0 12.7 18.0))
      (400 . (400.0 180.0 8.6 13.5 21.0))
      (450 . (450.0 190.0 9.4 14.6 21.0))
      (500 . (500.0 200.0 10.2 16.0 21.0))
      (550 . (550.0 210.0 11.1 17.2 24.0))
      (600 . (600.0 220.0 12.0 19.0 24.0))
    )
  IPEA_data
    '(
       (80 . (78.0 46.0 3.3 4.2 5.0))
      (100 . (98.0 55.0 3.6 4.7 7.0))
      (120 . (117.6 64.0 3.8 5.1 7.0))
      (140 . (137.4 73.0 3.8 5.6 7.0))
      (160 . (157.0 82.0 4.0 5.9 9.0))
      (180 . (177.0 91.0 4.3 6.5 9.0))
      (200 . (197.0 100.0 4.5 7.0 12.0))
      (220 . (217.0 110.0 5.0 7.7 12.0))
      (240 . (237.0 120.0 5.2 8.3 15.0))
      (270 . (267.0 135.0 5.5 8.7 15.0))
      (300 . (297.0 150.0 6.1 9.2 15.0))
      (330 . (327.0 160.0 6.5 10.0 18.0))
      (360 . (357.6 170.0 6.6 11.5 18.0))
      (400 . (397.0 180.0 7.0 12.0 21.0))
      (450 . (447.0 190.0 7.6 13.1 21.0))
      (500 . (497.0 200.0 8.4 14.5 21.0))
      (550 . (547.0 210.0 9.0 15.7 24.0))
      (600 . (597.0 220.0 9.8 17.5 24.0))
    )
  HEA_data
    '(
      (100 . (96.0 100.0 5.0 8.0 12.0))
      (120 . (114.0 120.0 5.0 8.0 12.0))
      (140 . (133.0 140.0 5.5 8.5 12.0))
      (160 . (152.0 160.0 6.0 9.0 15.0))
      (180 . (171.0 180.0 6.0 9.5 15.0))
      (200 . (190.0 200.0 6.5 10.0 18.0))
      (220 . (210.0 220.0 7.0 11.0 18.0))
      (240 . (230.0 240.0 7.5 12.0 21.0))
      (260 . (250.0 260.0 7.5 12.5 24.0))
      (280 . (270.0 280.0 8.0 13.0 24.0))
      (300 . (290.0 300.0 8.5 14.0 27.0))
      (320 . (310.0 300.0 9.0 15.5 27.0))
      (340 . (330.0 300.0 9.5 16.5 27.0))
      (360 . (350.0 300.0 10.0 17.5 27.0))
      (400 . (390.0 300.0 11.0 19.0 27.0))
      (450 . (440.0 300.0 11.5 21.0 27.0))
      (500 . (490.0 300.0 12.0 23.0 27.0))
      (550 . (540.0 300.0 12.5 24.0 27.0))
      (600 . (590.0 300.0 13.0 25.0 27.0))
      (650 . (640.0 300.0 13.5 26.0 27.0))
      (700 . (690.0 300.0 14.5 27.0 27.0))
      (800 . (790.0 300.0 15.0 28.0 30.0))
      (900 . (890.0 300.0 16.0 30.0 30.0))
     (1000 . (990.0 300.0 16.5 31.0 30.0))
     (1100 . (1090.0 300.0 18.0 31.0 20.0))
    )
  HEB_data
    '(
      (100 . (100.0 100.0 6.0 10.0 12.0))
      (120 . (120.0 120.0 6.5 11.0 12.0))
      (140 . (140.0 140.0 7.0 12.0 12.0))
      (160 . (160.0 160.0 8.0 13.0 15.0))
      (180 . (180.0 180.0 8.5 14.0 15.0))
      (200 . (200.0 200.0 9.0 15.0 18.0))
      (220 . (220.0 220.0 9.5 16.0 18.0))
      (240 . (240.0 240.0 10.0 17.0 21.0))
      (260 . (260.0 260.0 10.0 17.5 24.0))
      (280 . (280.0 280.0 10.5 18.0 24.0))
      (300 . (300.0 300.0 11.0 19.0 27.0))
      (320 . (320.0 300.0 11.5 20.5 27.0))
      (340 . (340.0 300.0 12.0 21.5 27.0))
      (360 . (360.0 300.0 12.5 22.5 27.0))
      (400 . (400.0 300.0 13.5 24.0 27.0))
      (450 . (450.0 300.0 14.0 26.0 27.0))
      (500 . (500.0 300.0 14.5 28.0 27.0))
      (550 . (550.0 300.0 15.0 29.0 27.0))
      (600 . (600.0 300.0 15.5 30.0 27.0))
      (650 . (650.0 300.0 16.0 31.0 27.0))
      (700 . (700.0 300.0 17.0 32.0 27.0))
      (800 . (800.0 300.0 17.5 33.0 30.0))
      (900 . (900.0 300.0 18.5 35.0 30.0))
     (1000 . (1000.0 300.0 19.0 36.0 30.0))
     (1100 . (1100.0 300.0 20.0 36.0 20.0))
    )
  HEM_data
    '(
      (100 . (120.0 106.0 12.0 20.0 12.0))
      (120 . (140.0 126.0 12.5 21.0 12.0))
      (140 . (160.0 146.0 13.0 22.0 12.0))
      (160 . (180.0 166.0 14.0 23.0 15.0))
      (180 . (200.0 186.0 14.5 24.0 15.0))
      (200 . (220.0 206.0 15.0 25.0 18.0))
      (220 . (240.0 226.0 15.5 26.0 18.0))
      (240 . (270.0 248.0 18.0 32.0 21.0))
      (260 . (290.0 268.0 18.0 32.5 24.0))
      (280 . (310.0 288.0 18.5 33.0 24.0))
      (300 . (340.0 310.0 21.0 39.0 27.0))
      (320 . (359.0 309.0 21.0 40.0 27.0))
      (340 . (377.0 309.0 21.0 40.0 27.0))
      (360 . (395.0 308.0 21.0 40.0 27.0))
      (400 . (432.0 307.0 21.0 40.0 27.0))
      (450 . (478.0 307.0 21.0 40.0 27.0))
      (500 . (524.0 306.0 21.0 40.0 27.0))
      (550 . (572.0 306.0 21.0 40.0 27.0))
      (600 . (620.0 305.0 21.0 40.0 27.0))
      (650 . (668.0 305.0 21.0 40.0 27.0))
      (700 . (716.0 304.0 21.0 40.0 27.0))
      (800 . (814.0 303.0 21.0 40.0 30.0))
      (900 . (910.0 302.0 21.0 40.0 30.0))
     (1000 . (1008.0 302.0 21.0 40.0 30.0))
    )
  PA_data IPEA_data
)
  (setq sv_mnu (getvar "SHORTCUTMENU"))
  (setvar "SHORTCUTMENU" 11)
  (initget 1 "IPE IPEA PA HEA HEB HEM")
  (setq typ_ipn (getkword "\nType de poutre [IPE/IPEA/PA/HEA/HEB/HEM]?: "))
  (setq l_data (eval (read (strcat typ_ipn "_data"))))
  (setq l_str nil)
  (initget 1 (apply 'strcat (mapcar 'strcat (repeat (length l_data) (setq l_str (cons "M" l_str))) (mapcar 'itoa (mapcar 'car l_data)) (repeat (length l_data) (setq l_str (cons " " l_str))))))
  (setq l_str nil)
  (setq model_ipn (getkword (strcat "\nModèle de poutre ["
    (apply 'strcat (mapcar 'strcat (repeat (length l_data) (setq l_str (cons "M" l_str))) (mapcar 'itoa (mapcar 'car l_data)) (repeat (length l_data) (setq l_str (cons "/" l_str)))))
    "]?: "))
  )
  (setvar "SHORTCUTMENU" sv_mnu)
  (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
		(progn
			(initget "ME CM MM")
			(if (not (setq unit_key (getkword "\nDessin réalisé en [ME/CM/MM] <MM>: ")))
				(setq unit_key "MM")
			)
			(cond
				((eq unit_key "ME")
					(setq unit_draw 1000)
				)
				((eq unit_key "CM")
					(setq unit_draw 10)
				)
				((eq unit_key "MM")
					(setq unit_draw 1 unit_key "MM")
				)
			)
			(setvar "USERS5" (strcat "qz" (itoa unit_draw)))
		)
		(progn
			(setq unit_draw (atoi (substr (getvar "USERS5") 3)))
			(cond
				((eq unit_draw 1000)
					(setq unit_key "M")
				)
				((eq unit_draw 10)
					(setq unit_key "CM")
				)
				((eq unit_draw 1)
					(setq unit_key "MM")
				)
			)
		)
	)
  (setq l_val (mapcar '/ (cdr (assoc (atoi (substr model_ipn 2)) l_data)) (list unit_draw unit_draw unit_draw unit_draw unit_draw)))
  (initget 1)
  (setq pt_ins (getpoint "\nPoint d'insertion?: "))
  (setq h (car l_val) b (cadr l_val) a (caddr l_val) e (cadddr l_val) r (last l_val))
  (setq
    po (polar pt_ins (* pi 0.5) (* h -0.5))
    p1 (polar po 0.0 (* b 0.5))
    p2 (polar p1 (* pi 0.5) e)
    p3 (polar p2 pi (- (* b 0.5) (* a 0.5) r))
    p4 (polar (polar p3 (* pi 0.5) r) pi r)
    p5 (polar p4 (* pi 0.5) (- h (* 2.0 r) (* 2.0 e)))
    p6 (polar (polar p5 0.0 r) (* pi 0.5) r)
    p7 (polar p6 0.0 (- (* b 0.5) (* a 0.5) r))
    p8 (polar p7 (* pi 0.5) e)
    p9 (polar p8 pi b)
    p10 (polar p9 (- (* pi 0.5)) e)
    p11 (polar p10 0.0 (- (* b 0.5) (* a 0.5) r))
    p12 (polar (polar p11 (- (* pi 0.5)) r) 0.0  r)
    p13 (polar p12 (- (* pi 0.5)) (- h (* 2.0 r) (* 2.0 e)))
    p14 (polar (polar p13 pi r) (- (* pi 0.5)) r)
    p15 (polar p14 pi (- (* b 0.5) (* a 0.5) r))
    p16 (polar p15 (- (* pi 0.5)) e)
  )
  (setvar "cmdecho" 0)
  (command "_.pline" "_none" p1 "_none" p2 "_none" p3 "_arc" "_none" p4 "_line" "_none" p5 
  "_arc" "_none" p6 "_line" "_none" p7 "_none" p8 "_none" p9 "_none" p10 "_none" p11 
  "_arc" "_none" p12 "_line" "_none" p13 "_arc" "_none" p14 "_line" "_none" p15 "_none" p16
  "_close"
  )
  (setvar "cmdecho" 1)
  (command "_.rotate" (entlast) "" "_none" pt_ins pause)
  (command "_.extrude" (entlast) "")
  (prin1)
)

Community

Lisp for drafting welded 'T' profile

Lisp for drafting welded 'T' profile

Lisp for drafting welded 'T' profile