Leaderboard

Hi all, I just wrote my first DCL program. It's a renamer for blocks and layers. It has a block walk function to zoom into the block to be renamed from the selection, and the layers are highlighted when picked in the edit box. The rename dialog in ACAD hasn't been touched since I started using it in 2004 so I think this will help identify and rename Blocks and Layers much better. There is a bug whereby if something has been renamed, the zoom to block or highlighting of objects doesn't work. I'll try to fix the bug when I get some spare time. Fixed in v1.01 below. Thoughts on this and improvements are welcome. 3dwannab_Rename_Blocks_and_Layers.lsp 3dwannab_Rename_Blocks_and_Layers.dcl

@DeEng I suggest the following code instead. The value of (done_dialog) is returned from (start_dialog) when a call to (done_dialog) is made with an integer argument. (defun c:MAIN () (setvar "OSMODE" 0) (create-layers) (setq dcl_id (load_dialog "kart.dcl")) (if (not dcl_id) (alert "DCL file could not be loaded!") ) (if (new_dialog "main_dialog" dcl_id) (progn (action_tile "btn_info" "(done_dialog 1)");<---set return value in (done_dialog) to be captured by the result of (start_dialog) (action_tile "btn_holes" "(done_dialog 2)") (action_tile "btn_open_model" "(done_dialog 3)") (action_tile "btn_open_card" "(done_dialog 4)") (action_tile "btn_working_directory" "(done_dialog 5)") (action_tile "btn_exit" "(done_dialog 0)") (setq useraction (start_dialog));<---- Capture result of (done_dialog) ) ) (unload_dialog dcl_id) (cond ((= userAction 1) (show_info_dialog)) ((= userAction 2) (show_holes_dialog)) ((= userAction 3) (open_model_file)) ((= userAction 4) (open_card_file)) ((= userAction 5) (select_working_directory)) ((= userAction 0) (princ "\nDone."));<---- Exit is not necessary here. (T (alert "No valid action selected.")) ) ) The AutoCAD Help is not very clear on this, but you can use ANY integer value in (done_dialog) and it will be returned to (start_dialog). https://help.autodesk.com/view/ACDLT/2024/ENU/?guid=GUID-A150544E-ACE5-415F-AAB4-930E2715FDC7 ALSO: as i noted previously, (exit) is not necessary. It evokes the error handler, which is not desired to exit a function cleanly.

Thank you for posting your solution. It may help someone else down the road.

Exactly - and using an image_button in place of a regular button.

One tile should have the is_cancel attribute for the 'x' button to remain operational; note that the same tile can have both is_default & is_cancel.

@harimaddddy It has to do with how you are getting the elevation numbers from the text: 1) since there is more than 1 text, the 1st entity in the selection set is not always the "EL. X", 2) the negative "-" sign does not equate to a number and it skips it in your loop to look for numbers. It's better just to look for a specific string and parse it as always having the same format. Other things: - Doing a "move to nowhere" is not the best way to get the non-text out of the selection set. it's better just to iterate through the selection and filter out the non-text entities into a new selection set. - Note I use command modifiers as standard practice, "_" helps if using non-english versions, "." ensures you are always using the original AutoCAD command even if someone has over written it with a LISP function. - I added some error handling "IF" statements to prevent errors if the user doesn't select the proper items or if they do not select / enter anything for the displacement points. - I use "_non" modifiers on commands that ask for points to prevent any object snaps from interfering with the copies. Not totally necessary, but I do it standard whenever i use predefined points in a command. - I localized all the variables - I added undo marks and turned off the CMDECHO system variable to get rid of all the extra prompts being shown. Here is my update to your program: ; Source:https://www.cadtutor.net/forum/topic/68426-create-automatic-level-in-metric/ ; Re-written by PJK 11/14/2024 (Defun c:BT (/ a b ct i lset oe n sst sset str te tv) (command "._undo" "_be") (setq oe (getvar "cmdecho")) (setvar "cmdecho" 0) (if (setq sst (ssget)) (progn (setq sset (ssget "P" '((0 . "TEXT"))) lset (ssadd) ) ; Filter out non-text and add to new selection "lset" (repeat (sslength sst) (if (/= "TEXT" (cdr (assoc 0 (entget (ssname sst (setq i (if i (1+ i) 0))))))) (ssadd (ssname sst i) lset) ) ) ; search through the text selection set to find the Elevation note. (repeat (sslength sset) (setq te (ssname sset (setq n (if n (1+ n) 0))) tv (cdr (assoc 1 (entget te))) ) ; if the prefix is found, (if (= "EL." (substr tv 1 3)) (progn ; get the numeric value and save the entity. (setq str (distof (substr tv 5)) ct te) ; remove it from the selection set. (ssdel te sset) ) ) ) ; if everything is found and the source and destination points are supplied, (if (and lset sset str (setq a (getpoint "\n Specify the source point: ")) (Setq b (getpoint a "\n Specify the Desitnation point: ")) ) (progn ;; Copy the elevation text up. (command "._copy" ct "" "_non" a "_non" b) ;; change the elevation text to the new value. (command "change" (entlast) "" "" "" "" "" "" (strcat "EL. " (rtos (+ str (- (cadr B )(cadr A))) 4 2))) ; Copy the rest of the stuff. (command "._Copy" lset sset "" "_non" a "_non" b) ) (princ "\nWrong selection or no displacement supplied.") ) ) ) (command "._undo" "_end") (setvar "cmdecho" oe) (princ) )

Waiting for dwg but I would use. Note space after setq in some cases with no space can be interpreted as a defun. Makes code easier to read. (Setq sst (ssget '(0 . "TEXT,LINE")))

A very simple answer is, it is your turn to do a little home work and learn at same time. Google "RTOS Autodesk" Have a look in the code you should be able to find it very quickly what to change.

@CivilTechSource you dont need to start a new topic this request can be added to your other post. Admin please merge into other post. Just a comment as your using multi if's it is probably better to start coding using a COND.

Hi @CivilTechSource, You need to add a (princ) (choose one of these): - the first one you can add (princ) inside of each "progn" after (princ "\nOhhhh.....) and (princ "\nAll.....) - the second one you can add (princ) after "if" statement, before or after ";----" in your code. Adding a (princ) you will get a "clean" output in command line.

What is interesting is that mline which allows multiple lines does not have the arc option. So dline in a way was more advanced. Again Autodesk no update since 1992 rather probably look at it as a to simple task so no update, but there happy to keep taking your money for upgrades.

I've now incorporated this feature into Version 1.1.

Good task for learning lisp. The steps. Pick block 1 using entsel, get insertion point, get X1 & Y1 Pick block 2 using entsel, get insertion point get X2 & Y2 Hor dist X2 -X1 Ver dist Y2-Y1 Have a go, never to late to learn.

The following offers another method using a temporary saved view - the advantage being that the user can adjust the view plane in addition to zooming & panning: (defun c:test ( / *error* doc idx obj vpo vwc vwn ) (defun *error* ( msg ) (if (and (= 'vla-object (type obj)) (vlax-write-enabled-p obj)) (vla-delete obj) ) (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (setq doc (vla-get-activedocument (vlax-get-acad-object)) vwc (vla-get-views doc) idx 0 ) (while (itemp vwc (setq vwn (strcat "$temp" (itoa (setq idx (1+ idx))))))) (setq obj (vla-add vwc vwn) vpo (vla-get-activeviewport doc) ) (foreach prp '(center direction height target width) (vlax-put-property obj prp (vlax-get-property vpo prp)) ) (getpoint "\nPan & zoom around...") (vla-setview vpo obj) (vla-put-activeviewport doc vpo) (*error* nil) (princ) ) (defun itemp ( col key ) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list col key)))) ) (vl-load-com) (princ)

In the above I've only put in a few details as an example of how you could add in a drop down box - but like all CAD there are many ways to do the same thing. use the above to learn from. In your specific example I'd do something like this though: Add a default value to 'MyAnswer' early in the LISP to avoid errors later, value 0 - the first item in the drop down list In the drop down list only set MyAnswer to the position of the selection. If you use the default above there is no error if the user does nothing with the list Continue in the routing using the value of MyAnswer to set t1 and t2 where they are used and set - below using an if comment but if the drop down is longer, use conds. (defun c:test (/ *error* dch dcl des a MyAnswer t1 t2) (defun *error* ( msg ) (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch) ) ; end if (if (= 'file (type des)) (close des) ) ; end if (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl) ) ; end if (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))) (princ (strcat "\nError: " msg)) ) ; end if (princ) ) ; end defun (setq MyAnswer 1) ;; Initial condition (cond ((not (setq dcl (vl-filename-mktemp nil nil ".dcl") des (open dcl "w") ) ; end setq ) ; end not (princ "\nUnable to open DCL for writing.") ) ; end cond 'not' ((progn (foreach str '( "ed : edit_box" "{" " alignment = left;" " width = 20;" ;; " edit_width = 10;" ;; " fixed_width = true;" "}" "" "peacost : dialog" "{" " spacer;" " key = \"dcl\";" " : row" " {" " : ed { key = \"a\"; label = \"Area:\"; }" " : ed { key = \"res1\"; label = \"Calc:\"; is_enabled = false; }" " }" " : row" " {" " : ed { key = \"res2\"; label = \"Text :\"; is_enabled = false; }" " }" " spacer;" " : row {" ;;ADDED THESE LINES " :column { width = 5;" " : text { key = \"File\"; label = \"List Title\"; width = 5; alignment = left;}" " }" ; end column " :column { width = 22;" " :popup_list { key = \"DCLList\"; width = 20; multiple_select = true ; alignment = left; }" " }" ; end column " }" ; end row ;; TO HERE " : row" " {" " : column { width = 10;" " }" ; end column " : column { width = 17;" " : button { key = \"cal\"; label = \"Calc\"; is_default = true;" " is_cancel = false; fixed_width = true; width = 10; }" " }" ; end column " : column { width = 17;" " : button { key = \"OK\"; label = \"OK\"; is_default = true;" " is_cancel = true; fixed_width = true; width = 10; }" " }" ; end column " }" ; end row "}" ) ; end str list (write-line str des) ) ; end foreach (setq des (close des) dch (load_dialog dcl) ) ; end str (<= dch 0) ) (princ "\nUnable to load DCL file.") ) ( (not (new_dialog "peacost" dch)) (princ "\nUnable to display 'peacost' dialog.") ) ; end cond (t ;;Set DCL Tile values (set_tile "dcl" "Any name") (setq MyList '("Option 1" "Option 2" "D" "E")) (start_list "DCLList" 3)(mapcar 'add_list MyList)(end_list) ;;DCL Actions (action_tile "a" "(setq a $value)") (action_tile "DCLList" "(setq MyAnswer (read (get_tile \"DCLList\")))" ) (action_tile "cal" (vl-prin1-to-string '( (lambda ( / x) (set_tile "res1" "") (set_tile "res2" "") (if (= MyAnswer 1) (setq t2 354.84) ;;option 2 (setq t2 322.58) ;; everything else ) (cond ((or (not a) (= "" a)) (alert "xxxxxxxxxxxxx !!!") (mode_tile "a" 2) ) ((not (setq e (distof a))) (alert "xxxxxxxxxxxxxx!!!") (mode_tile "a" 2) ) ((<= e 250) (if (= MyAnswer 1) (setq t1 (/ (+ (* e 2.75) 85) 1.24)) ;;option 2 (setq t1 (/ (+ (* e 2.5) 75) 1.24)) ;; everything else ) (mode_tile "a" 2) (set_tile "res1" (rtos (if (> t1 t2) t2 t1) 2 2)) (set_tile "res2" "text text text") ) ((and (> e 250) (<= e 1000)) (if (= MyAnswer 1) (setq t1 (/ (+ (* e 2.75) 85) 1.24)) ;;option 2 (setq t1 (/ (+ (* e 2.5) 75) 1.24)) ;; everything else ) (mode_tile "a" 2) (set_tile "res1" (rtos (if (> t1 t2) t2 t1) 2 2)) (set_tile "res2" "text text text") ) ((> e 1000) (if (= MyAnswer 1) (setq t1 (/ (+ (* e 2.75) 85) 1.24)) ;;option 2 (setq t1 (/ (+ (* e 2.5) 75) 1.24)) ;; everything else ) (mode_tile "a" 2) (set_tile "res1" (rtos (if (> t1 t2) t2 t1) 2 2)) (set_tile "res2" "text text text") ) ) ; end cond ) ) ) ) (start_dialog) ) ) (*error* nil) )

I am not the best at lisp routines but can edit them ok. Thanks for the lesson. I went online and found the syntax and edited it and now it is working well. (cons 1 (rtos (last cls) 2 0))

@pkenewell the attribute holds an elevation, the pline is at say 0.0, so need to set the pline elevation 1st, as you have suggested once the pline has an elevation you could using your method set the attribute to the pline elevation field, that way change the pline value and atrribute updates, matches current sample dwg. You could check the attribute string to see if a field if not then update pline & attribute. We need @Civils_Ben to confirm the choice of method, how is the elevation first worked out and do you set pline or attribute ? Is it auto labelled, Civil software can do that sort of thing. Just a comment , you could use a lisp as every time you insert the elevation block must get the ID of the corresponding pline.

There is software that draws lighting diagrams looking at a reflective value on say the ground these show the brightness at a point. a bit like a contour map of brightness. Were I worked we did a few lighting involved projects but we shopped out the light design. I would be very careful of using ACAD "LIGHTS" it will give you an idea but for a project like this need it properly analyzed. Very, very expensive if you get it wrong. Just a funny comment about sports ground lights, many years ago they built a major football stadium, it had multi lights for night games, so the powers to be decided it would be a good idea to turn on all the tower lights at the one time in a blaze of glory, well that lasted a couple of seconds, they sucked that much power they blacked out the entire neighborhood for 4 hours. Any one from Melbourne will know about Waverly stadium. Yes they did have night games turning on small banks one at a time.

Please use Code Tags in the future. (<> in the editor toolbar)

Note that the 'report' that you are describing is merely the value returned by the (defun) expression - per the documentation: This is no different to typing (+ 1 1) at the command line and observing 2 as the return value of the + function; that is, there is nothing special about running a custom command and seeing a return value versus evaluating an arbitrary LISP expression and seeing a return value. Given this, the documentation for the (princ) function reveals why two outputs are observed: Hence, when typing (princ "Hello World!") to the command line, you'll obtain: Command: (princ "Hello World!") Hello World!"Hello World!" The first being the operation (aka side effect) of the (princ) function, the second being the value returned by the (princ) function. Now, given that (defun) returns the value returned by the last evaluated expression, and (princ) returns the value of the evaluated expression, if you define a function such as: (defun c:test ( ) (princ "Hello World!") ) You will obtain the following output: Command: TEST Hello World!"Hello World!" Since (princ) has printed the string to the command line and returned "Hello World!" to the (defun) expression, and the (defun) expression has in turn returned "Hello World!" as its own return value. Therefore, by modifying the function definition to: (defun c:test ( ) (princ "Hello World!") (princ) ) The first (princ) expression still returns "Hello World!" to the (defun) expression, but it is no longer the last evaluated expression - the second (princ) with no arguments will return a null symbol to the (defun) expression, which will then be returned by the (defun) expression, resulting in no visible output to the command line.

Using Tharwats code? Look at this section (setq txt (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 10 cls) (cons 1 (rtos (last cls) 2 2)) (cons 40 (* 0.00175 *MHY:Scale*)) (cons 8 "Contour Label") '(50 . 0.0) '(71 . 5) '(72 . 5) '(73 . 1) '(210 0.0 0.0 1.0) ) ) ) Add '(7 . "Text_Style") where text style is your font in between '(50 . ...) and '(71 . ...). Here using Standard text style: '(50 . 0.0) '(7 . "Standard") '(71 . 5) For height modify the (cons 40 (* 0.00175 *MHY@Scale*)) if necessary. Either change the 0.00175 to a different number or replace the whole (* 0.00175 *MHY:Scale*) to a value if you want the same height all the time eg. (cons 40 2.5)

And if you use the command DVIEW? ((lambda ( / e_sel e pt_sel) (princ "\nSelect an object.") (cond ((setq e_sel (entsel)) (setq e (car e_sel) pt_sel (osnap (cadr e_sel) "_near")) (command "_.dview" e "" "_points" "_none" (list (car pt_sel) (cadr pt_sel) 0.0) "_none" (list (car pt_sel) (cadr pt_sel) 1.0) "" ) ) (T (princ "\nNothing selected.")) ) (prin1) ))

You are out to 283 posts so it is time you started to have a go at making lisps. I have supplied the "change the mtext", you need to add the ssget, a repeat and check does foundstr=oldstr if yes then change foundstr.

Did you contact Autodesk? This happened several years ago and they did an update to fix it. Not sure what version it was. Did you check your graphics card and drivers? Ghosted, dragged, or duplicated objects appear in AutoCAD 3D objects disappear, display wrong, shift position, move, or offset from grips in AutoCAD

If you want one dwg only at a time then you can get the string "AAA\\PBBB\\PCCC". You can then pull it apart ("AAA" "BBB" "CCC") for me using multi getvals.lsp I would pop a dcl with each line as an entry up to about 15 lines works. Then change the required values and update even multiple Mtext. Look in downloads fo the lisp. I seem to recall splitting the mtext by using string replace \\P now * then using Lee's split string. For multiple dwgs version 2 using OBDX. I will let you work out how to search for multiple mtext. The method does work. ; tab 9 space 32 (chr 32) comma 44 semicolum 59 slash / 47 ~ 126 ; thanks to Lee-mac for this defun (defun c:test ( / ) (defun csv->lst126 ( str / pos ) (if (setq pos (vl-string-position 126 str)) (cons (substr str 1 pos) (csv->lst126 (substr str (+ pos 2)))) (list str) ) ) (setq obj (vlax-ename->vla-object (car (entsel "\nPick mtext object ")))) (setq str (vlax-get obj 'textstring)) (setq str2 str) (while (> (setq pos (vl-string-search "\P" str)) 0) (setq str (vl-string-subst "~" "\P" str pos)) (setq pos (vl-string-search "\\" str)) (setq str (vl-string-subst "" "\\" str pos)) ) (setq lst (csv->lst126 str)) (setq lst2 '() x 1) (foreach val lst (setq lst2 (cons (strcat "Line" (rtos x 2 0)) lst2)) (setq lst2 (cons 20 lst2)) (setq lst2 (cons 19 lst2)) (setq lst2 (cons val lst2)) (setq x (1+ x)) ) (setq lst2 (reverse lst2)) (setq lst2 (cons "Please edit" lst2)) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm lst2)) (setq x 0 newstr "") (repeat (- (length ans) 1) (setq val (nth x ans)) (setq newstr (strcat newstr val "\\P")) (setq x (1+ x)) ) (setq newstr (strcat newstr (nth x ans))) (vlax-put obj 'textstring newstr) (princ) ) Multi GETVALS.lsp

There is a LISP or 2 out there that does end styles. Draw a Cap or Pipe End | CAD Tips I do have DLine LISP from long ago, as well as your update now, thank you very much. Never used Multiline as far as I can remember. I have Insert Doors by Automatically Breaking Walls | CAD Tips when needed. Last big job I did that needed a lot of doors and walls I used AutoCAD Architectural. AutoCAD has too many half-baked tools IMO.

Autocad hasn't had a good feature added to it since dynamic blocks back in 2006 if I remember correctly. Almost 20 years ago. Mline is just half baked. It could have the ability to set different end styles. Like more complex ones to represent a cavity wall for example.

Here's the DLINE.lsp fixed. This .lsp program is from 1992, and in the header, AD allow permission to use, copy, modify, and distribute it so long as the header is kept intact so here you go. With the introduction of lisp in 2025 LT, this should work as this problem still exists with the full version in 2025. ;; ;; DLINE.lsp, modified by 3dwannab 2024.11.03 ;; Modified to keep the users original osmode while the DLINE command is active by using "_non" before command calls like line, arc etc. ;; Modified/Fixed to use command-s in the error handler instead of the command call. ;; ;;; DLINE.LSP ;;; Copyright (C) 1990-1992 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 this permission notice appear in ;;; all supporting documentation. ;;; ;;; 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. ;;; ;;; DESCRIPTION ;;; ;;; This is a general purpose "double-line/arc" generator. It performs ;;; automatic corner intersection cleanups, as well as a number of other ;;; features described below. ;;; ;;; The user is prompted for a series of endpoints. As they are picked ;;; "DLINE" segments are drawn on the current layer. Options are ;;; available for changing the Width of the DLINE, specifying whether ;;; or not to Snap to existing lines or arcs, whether or not to ;;; Break the lines or arcs when snapping to them, and which of the ;;; following to do: ;;; ;;; Set the global variable dl:ecp to the values listed below: ;;; ;;; Value Meaning ;;; --------------------------- ;;; 0 No end caps ;;; 1 Start end cap only ;;; 2 Ending end cap only ;;; 3 Both end caps ;;; 4 Auto ON -- Cap any end not on a line or arc. ;;; ;;; The user may choose to back up as far as the beginning of the command ;;; by typing "U" or "Undo", both of which operate as AutoCAD's "UNDO 1" ;;; does. ;;; ;;; Curved DLINE's are drawn using the AutoCAD ARC command and follow as ;;; closely as possible its command structure for the various options. ;;; ;;;---------------------------------------------------------------------------- ;;; OPERATION ;;; ;;; The routine is executed, after loading, by typing either DL or DLINE ;;; at which time you are presented with the opening line and menu of ;;; choices: ;;; ;;; Dline, Version 1.11, (c) 1990-1992 by Autodesk, Inc. ;;; Break/Caps/Dragline/Offset/Snap/Undo/Width/<start point>: ;;; ;;; Typing Break allows you to set breaking of lines and arcs found at ;;; the start and end points of any segment either ON or OFF. ;;; ;;; Break Dline's at start and end points? OFF/<ON>: ;;; ;;; Typing Caps allows you to specify how the DLINE will be finished ;;; off when exiting the routine, per the values listed above. ;;; ;;; Draw which endcaps? Both/End/None/Start/<Auto>: ;;; ;;; The default of Auto caps an end only if you did not snap to an arc ;;; or line. ;;; ;;; Typing Dragline allows you to set the location of the dragline ;;; relative to the centerline of the two arcs or lines to any value ;;; between - 1/2 of "tracewid" and + 1/2 of "tracewid". (There is a ;;; local variable you may set if you want to experiment with offsets ;;; outside this range; the results may not be correct, your choice. ;;; See the function (dl_sao) for more information.) ;;; ;;; Set dragline position to Left/Center/Right/<Offset from center = 0.0>: ;;; ;;; Enter any real number or one of the keywords. The value in the angle ;;; brackets is the default value and changes as you change the dragline ;;; position. ;;; ;;; Offset allows the first point you enter to be offset from a known ;;; point. ;;; ;;; Offset from: (enter a point) ;;; Offset toward: (enter a point) ;;; Enter the offset distance: (enter a distance or real number) ;;; ;;; Snap allows you to set the snapping size and turn snapping ON or OFF. ;;; ;;; Set snap size or snap On/Off. Size/OFF/<ON>: ;;; New snap size (1 - 10): ;;; ;;; The upper limit may be reset by changing the value of MAXSNP to a ;;; value other than 10. Higher values may be necessary for ADI display ;;; drivers, but generally, you should keep this value somewhere in the ;;; middle of the allowed range for snapping to work most effectively ;;; in an uncluttered drawing, and toward the lower end for a more ;;; cluttered drawing. You may also use object snap to improve your ;;; aim. ;;; ;;; This feature allows you to very quickly "snap" to another line or arc, ;;; breaking it at the juncture and performing all of the intersection ;;; cleanups at one time without having to be precisely on the line, i.e., ;;; you can be visually one the line and it will work, or you can use ;;; object snap to be more precise. ;;; ;;; Undo backs you up one segment in the chain of segments you are drawing, ;;; stopping when there are no more segments to be undone. All of the ;;; necessary points are saved in lists so that the DLINE will close, cap, ;;; and continue correctly after any number of undo's. ;;; ;;; Width prompts you for a new width. ;;; ;;; New DLINE width <1.0000>: ;;; ;;; You may enter a new width and continue the DLINE in the same direction ;;; you were drawing before; if you do this, connecting lines from the ;;; endpoints of the previous segment are drawn to the start points of ;;; the new segment. ;;; ;;; If you press RETURN after closing a DLINE or before creating any ;;; DLINE's, you will see this message: ;;; ;;; No continuation point -- please pick a point. ;;; Break/Caps/Dragline/Offset/Snap/Undo/Width/<start point>: ;;; ;;; After you pick the first point, you will see this set of options: ;;; ;;; Arc/Break/CAps/CLose/Dragline/Snap/Undo/Width/<next point>: ;;; ;;; Picking more points will draw straight DLINE segments until either ;;; RETURN is pressed or the CLose option is chosen. ;;; ;;; CLose will close the lines if you have drawn at least two segments. ;;; ;;; Selecting Arc presents you with another set of choices: ;;; ;;; Break/CAps/CEnter/CLose/Dragline/Endpoint/Line/Snap/Undo/Width/<second point>: ;;; ;;; All of the options here are the same as they are for drawing straight ;;; DLINE's except CEnter, Endpoint, and Line. ;;; ;;; The default option, CEnter, and Endpoint are modeled after the ARC ;;; command in AutoCAD and exactly mimic its operation including all of ;;; the subprompts. Refer to the AutoCAD reference manual for exact usage. ;;; ;;; The Line option returns you to drawing straight DLINE segments. ;;; ;;; Snapping to existing LINE's an ARC's accomplishes all of the trimming ;;; and extending of lines and arcs necessary, including cases where arcs ;;; and lines do not intersect. In these cases a line is drawn from either; ;;; a point on the arc at the perpendicular point from the center of the ;;; arc to the line, to the line, or along the line from the centers of the ;;; two arcs that do not intersect at the points where this line crosses ;;; the two arcs. In this way, we ensure that all DLINE's can be closed ;;; visually. ;;; ;;; Breaking will not work unless Snapping is turned on. ;;; ;;;---------------------------------------------------------------------------- ;;; GLOBALS: ;;; dl:osd -- dragline alignment offset from center of two lines or arcs. ;;; dl:snp -- T if snapping to existing lines and arcs. ;;; dl:brk -- T if breaking existing lines and arcs. ;;; dl:ecp -- Bitwise setting of caps when exiting. ;;; v:stpt -- Continuation point. ;;;---------------------------------------------------------------------------- ;;; ;;; =========================================================================== ;;; ===================== load-time error checking ============================ ;;; (defun ai_abort (app msg) (defun *error* (s) (if old_error (setq *error* old_error)) (princ) ) (if msg (alert (strcat " Application error: " app " \n\n " msg " \n")) ) (exit) ) ;;; Check to see if AI_UTILS is loaded, If not, try to find it, ;;; and then try to load it. ;;; ;;; If it can't be found or it can't be loaded, then abort the ;;; loading of this file immediately, preserving the (autoload) ;;; stub function. (cond ((and ai_dcl (listp ai_dcl))) ; it's already loaded. ((not (findfile "ai_utils.lsp")) ; find it (ai_abort "DLINE" (strcat "Can't locate file AI_UTILS.LSP." "\n Check support directory." ) ) ) ((eq "failed" (load "ai_utils" "failed")) ; load it (ai_abort "DLINE" "Can't load file AI_UTILS.LSP") ) ) (if (not (ai_acadapp)) ; defined in AI_UTILS.LSP (ai_abort "DLINE" nil) ; a Nil <msg> supresses ) ; ai_abort's alert box dialog. ;;; ==================== end load-time operations =========================== ;;; Main function (defun dline (/ strtpt nextpt pt1 pt2 spts wnames elast uctr pr prnum temp ans dir ipt v lst dist cpt rad orad ftmp spt ept pt en1 en2 npt cpt1 flg cont flg2 flgn ang tmp undo_setting brk_e1 brk_e2 bent1 bent2 nn nnn dl_osm dl_oem dl_oce dl_opb dl_obm dl_ver dl_err dl_oer dl_arc fang MAXSNP ange savpt1 savpt2 savpt3 savpt4 savpts) ;; Version number. Reset this local if you make a change. (setq dl_ver "1.11") ;; Reset this value higher for ADI drivers. (setq MAXSNP 10) (setq dl_osm (getvar "osmode") dl_oce (getvar "cmdecho") dl_opb (getvar "pickbox") ) ;; ;; Internal error handler defined locally ;; (defun dl_err (s) ; If an error (such as CTRL-C) occurs ; while this command is active... (if (/= s "Function cancelled") (if (= s "quit / exit abort") (princ) (princ (strcat "\nError: " s)) ) ) (command-s "_.UNDO" "_EN") (ai_undo_off) (if dl_oer ; If an old error routine exists (setq *error* dl_oer) ; then, reset it ) (if dl_osm (setvar "osmode" dl_osm)) (if dl_opb (setvar "pickbox" dl_opb)) ;; Reset command echoing on error (if dl_oce (setvar "cmdecho" dl_oce)) (princ) ) ;; Set our new error handler (if (not *DEBUG*) (if *error* (setq dl_oer *error* *error* dl_err ) (setq *error* dl_err) ) ) (setvar "cmdecho" 0) (ai_undo_on) ; Turn on UNDO (command "_.UNDO" "_GROUP") ; (setvar "osmode" 0) ;; 3dwannab remove this setting to set osmode to 0 (if (null dl:opb) (setq dl:opb (getvar "pickbox"))) (setq nextpt "Straight") ;; Get the first segment's start point (menucmd "s=dline1") (graphscr) (princ (strcat "\nDline, Version " dl_ver ", (c) 1990-1992 by Autodesk, Inc. ")) (setq cont T) (while cont (dl_m1) ;; Ready to draw successive DLINE segments (dl_m2) ) (if dl_osm (setvar "osmode" dl_osm)) (if dl_opb (setvar "pickbox" dl_opb)) (ai_undo_off) ; Return UNDO to initial state ;; Reset command echoing (if dl_oce (setvar "cmdecho" dl_oce)) (menucmd "s=s") (princ) ) ;;; ;;; Main function subsection 1. ;;; ;;; dl_m1 == DLine_Main_1 ;;; (defun dl_m1 () (setq temp T uctr nil ) (if dl_arc (setq nextpt "Arc") (setq nextpt "Line") ) ;; temp set to nil when a valid point is entered. (while temp (initget "Break Caps Dragline Offset Snap Undo Width") (setq strtpt (getpoint "\nBreak/Caps/Dragline/Offset/Snap/Undo/Width/<start point>: " ) ) (cond ((= strtpt "Dragline") (dl_sao) ) ((= strtpt "Break") (initget "ON OFf") (setq dl:brk (getkword "\nBreak Dline's at start and end points? OFf/<ON>: " ) ) (setq dl:brk (if (= dl:brk "OFf") nil T)) ) ((= strtpt "Offset") (dl_ofs) ) ((= strtpt "Snap") (dl_sso) ) ((= strtpt "Undo") (princ "\nAll segments already undone. ") (setq temp T) ) ((= strtpt "Width") (initget 6) (dl_snw) (setq temp T) ) ((null strtpt) (if v:stpt (setq strtpt v:stpt temp nil ) (progn (princ "\nNo continuation point -- please pick a point. ") ) ) ) ((= strtpt "Caps") (endcap) ) ;; If none of the above, it must be OK to continue - a point has been ;; picked or entered from the keyboard. (T (setq v:stpt strtpt temp nil ) ) ) ) ) ;;; ;;; Main function subsection 2. ;;; ;;; dl_m3 == DLine_Main_2 ;;; (defun dl_m2 (/ temp) (setq spts (list strtpt) uctr 0 ) (if dl:snp (dl_ved "brk_e1" strtpt) ) ;; Make sure that the offset is not greater than 1/2 of "tracewid", even ;; if the user transparently resets it while the command is running. (setq temp (/ (getvar "tracewid") 2.0)) (if (< dl:osd (- temp)) (setq dl:osd (- temp)) ) (if (> dl:osd temp) (setq dl:osd temp) ) (while (and nextpt (/= nextpt "CLose")) (if (/= nextpt "Quit") (if dl_arc (progn (menucmd "s=dline2") (initget "Break CAps CEnter CLose Dragline Endpoint Line Snap Undo Width" ) (setq nextpt (getpoint strtpt (strcat "\nBreak/CAps/CEnter/CLose/Dragline/Endpoint/" "Line/Snap/Undo/Width/<second point>: " ) ) ) ) (progn (menucmd "s=dline3") (initget "Arc Break CAps CLose Dragline Snap Undo Width") (setq nextpt (getpoint strtpt "\nArc/Break/CAps/CLose/Dragline/Snap/Undo/Width/<next point>: " ) ) ) ) ) (setq v:stpt (last spts)) (cond ((= nextpt "Dragline") (dl_sao) ) ((= nextpt "Width") (dl_snw) ) ((= nextpt "Undo") (cond ;;((= uctr 0) (princ "\nNothing to undo. ") ) ((= uctr 0) (setq nextpt nil)) ((> uctr 0) (command "_.U") (setq spts (dl_lsu spts 1)) (setq savpts (dl_lsu savpts 2)) (setq wnames (dl_lsu wnames 2)) (setq uctr (- uctr 2)) (setq strtpt (last spts)) ) ) (if dl:snp (if (= uctr 0) (dl_ved "brk_e1" strtpt) ) ) ) ((= nextpt "Break") (initget "ON OFf") (setq dl:brk (getkword "\nBreak Dline's at start and end points? OFF/<ON>: " ) ) (setq dl:brk (if (= dl:brk "OFf") nil T)) (if dl:snp (dl_ved "brk_e1" strtpt) ) (if dl_arc (setq nextpt "Arc") (setq nextpt "Line") ) ) ((= nextpt "Snap") (dl_sso) ) ((= nextpt "Arc") (setq dl_arc T) ; Change to Arc segment prompt. ) ((= nextpt "Line") (setq dl_arc nil) ; Change to Line segment prompt. ) ((= nextpt "CLose") (dl_cls) ) ((= (type nextpt) 'LIST) (dl_ds) ) ((= nextpt "CEnter") (dl_ceo) ) ((= nextpt "Endpoint") (dl_epo) ) ((= nextpt "CAps") (endcap) ; Set which caps to draw when exiting. ) (T (setq nextpt nil cont nil ) (if (> uctr 1) (if (= (logand 4 dl:ecp) 4) (progn (if (null brk_e1) (command "_.LINE" "_non" savpt1 "_non" savpt2 "")) (dl_ssp) (if (null brk_e2) (command "_.LINE" "_non" savpt3 "_non" savpt4 "")) ) (progn (if (= (logand 1 dl:ecp) 1) (command "_.LINE" "_non" savpt1 "_non" savpt2 "") ) (if (= (logand 2 dl:ecp) 2) (progn (dl_ssp) (command "_.LINE" "_non" savpt3 "_non" savpt4 "") ) ) ) ) ) (if brk_e1 (setq brk_e1 nil)) (if brk_e2 (setq brk_e2 nil)) (command "_.UNDO" "_EN") ) ; end of inner cond ) ; end of outer cond ) ; end of while ) ;;; ------------------ End Main Functions --------------------------- ;;; ---------------- Begin Support Functions ------------------------ ;;; ;;; Close the DLINE with either straight or arc segments. ;;; If closing with arcs, the minimum number of segments already drawn ;;; is 1, otherwise it is 2. ;;; ;;; dl_cls == DLine_CLose_Segments ;;; (defun dl_cls () (if (or (and (null dl_arc) (< uctr 4) (if (> uctr 1) (/= (dl_val 0 (entlast)) "ARC") (not (> uctr 1)) ) ) (and dl_arc (< uctr 2)) ) (progn (princ "\nCannot close -- too few segments. ") (if dl_arc (setq nextpt "Arc") (setq nextpt "Line") ) ) (progn (command "_.UNDO" "_GROUP") (setq nextpt (nth 0 spts)) (if (null dl_arc) ;; Close with line segments (dl_mlf 3) (progn (setq tmp (last wnames) ange (trans '(1 0 0) (dl_val -1 tmp) 1) ange (angle '(0 0 0) ange) dir (if (= (dl_val 0 tmp) "LINE") (angle (trans (dl_val 10 tmp) 0 1) (trans (dl_val 11 tmp) 0 1) ) (progn (setq dir (+ (dl_val 50 tmp) ange) dir (if (> dir (* 2 pi)) (- dir (* 2 pi)) dir ) ) (if (equal dir (setq dir (angle (trans (dl_val 10 tmp) (dl_val -1 tmp) 1 ) strtpt ) ) 0.01 ) (- dir (/ pi 2)) (+ dir (/ pi 2)) ) ) ) ) (command "_.ARC" "_non" strtpt "_E" "_non" nextpt "_D" "_non" (* dir (/ 180 pi)) ) ;; Close with arc segments (dl_mlf 4) ) ) ;; set nextpt to "CLose" which will cause an exit. (setq nextpt "CLose" v:stpt nil cont nil ) ) ) ) ;;; ;;; A point was entered, do either an arc or line segment. ;;; ;;; dl_ds == DLine_Do_Segment ;;; (defun dl_ds () (if (equal strtpt nextpt 0.0001) (progn (princ "\nCoincident point -- please try again. ") (if dl_arc (setq nextpt "Arc") (setq nextpt "Line") ) ) (progn (command "_.UNDO" "_GROUP") (setq nextpt (list (car nextpt) (cadr nextpt) (caddr strtpt))) (if dl_arc (progn (command "_.ARC" "_non" strtpt "_non" nextpt) (prompt "\nEndpoint: ") (command pause) (setq nextpt (getvar "lastpoint") v:stpt nextpt ) (setq temp (entlast)) ;; Delete the last arc segment so we can find the line or ;; arc under it. (entdel temp) (if dl:snp (dl_ved "brk_e2" nextpt) ) ;; Restore the arc previously deleted. (entdel temp) ;; Draw the arc segments. (dl_mlf 2) ) (progn (setq v:stpt nextpt) (if dl:snp (dl_ved "brk_e2" nextpt) ) (if (and brk_e1 (eq brk_e1 brk_e2) (= (dl_val 0 brk_e1) "LINE")) (progn (princ "\nSecond point cannot be on the same line segment. ") (setq brk_e2 nil) ) ;; Draw the line segments. (dl_mlf 1) ) ) ) (if brk_e2 (setq nextpt "Quit")) ) ) ) ;;; ;;; The CEnter option for drawing arc segments was selected. ;;; ;;; dl_ceo == DLine_CEnter_Option ;;; (defun dl_ceo () (command "_.UNDO" "_GROUP") (setq temp T) (while temp (initget 1) (setq cpt (getpoint strtpt "\nCenter point: ")) (if (<= (distance cpt strtpt) (- (/ (getvar "tracewid") 2.0) dl:osd)) (progn (princ "\nThe radius defined by the selected center point is too small " ) (princ "\nfor the current Dline width. ") (princ "Please select another point.") ) (setq temp nil) ) ) ;; Start the ARC command so that we can get visual dragging. (command "_.ARC" "_non" strtpt "_C" "_non" cpt) (initget "Angle Length Endpoint") (setq nextpt (getkword "\nAngle/Length of chord/<Endpoint>: ")) (cond ((= nextpt "Angle") (prompt "\nIncluded angle: ") (command "_A" pause) (setq nextpt (dl_vnp) v:stpt nextpt ) ;; Draw the arc segments. (dl_mlf 2) ) ((= nextpt "Length") (prompt "\nChord length: ") (command "_L" pause) (setq nextpt (dl_vnp) v:stpt nextpt ) ;; Draw the arc segments. (dl_mlf 2) ) (T (prompt "\nEndpoint: ") (command pause) (setq nextpt (dl_vnp) v:stpt nextpt ) ;; Draw the arc segments. (dl_mlf 2) ) ) ) ;;; ;;; Endpoint option was selected. ;;; ;;; dl_epo == DLine_End_Point_Option ;;; (defun dl_epo () (command "_.UNDO" "_GROUP") (initget 1) (setq cpt (getpoint "\nEndpoint: ")) ;; Start the ARC command so that we can get visual dragging. (command "_.ARC" "_non" strtpt "_E" "_non" cpt) (initget "Angle Direction Radius Center") (setq nextpt (getkword "\nAngle/Direction/Radius/<Center>: ")) (cond ((= nextpt "Angle") (prompt "\nIncluded angle: ") (command "_A" pause) (setq nextpt (dl_vnp) v:stpt nextpt ) ;; Draw the arc segments. (dl_mlf 2) ) ((= nextpt "Direction") (prompt "\nTangent direction: ") (command "_D" pause) (setq nextpt (dl_vnp) v:stpt nextpt ) ;; Draw the arc segments. (dl_mlf 2) ) ((= nextpt "Radius") (setq temp T) (while temp (initget 1) (setq rad (getdist cpt "\nRadius: ")) (if (or (<= rad (/ (getvar "tracewid") 2.0)) (< rad (/ (distance strtpt cpt) 2.0)) ) (progn (princ "\nThe radius entered is less than 1/2 ") (princ "of the Dline width or is invalid") (princ "\nfor the selected endpoints. ") (princ "Please enter a radius greater than ") (if (< (/ (getvar "tracewid") 2.0) (/ (distance strtpt cpt) 2.0) ) (princ (rtos (/ (distance strtpt cpt) 2.0))) (princ (rtos (/ (getvar "tracewid") 2.0))) ) (princ ". ") ) (setq temp nil) ) ) (command "_R" rad) (setq nextpt (dl_vnp) v:stpt nextpt ) ;; Draw the arc segments. (dl_mlf 2) ) (T (prompt "\nCenter: ") (command pause) (setq nextpt (dl_vnp) v:stpt nextpt ) ;; Draw the arc segments. (dl_mlf 2) ) ) ) ;;; ;;; Set the ending save points for capping the DLINE. ;;; ;;; dl_ssp == DLine_Set_Save_Points ;;; (defun dl_ssp (/ temp) (setq temp (length savpts)) (if (> temp 1) (progn (setq savpt3 (nth (- temp 2) savpts) savpt4 (nth (- temp 1) savpts) ) ) ) ) ;;; ;;; Set the alignment of the "ghost" line to one of the following values: ;;; ;;; Left == -1/2 of width (Real number) ;;; > -1/2 of width (Real number) ;;; Center == 0.0 ;;; < +1/2 of width (Real number) ;;; Right == +1/2 of width (Real number) ;;; ;;; All of the alignment options are taken as if you are standing at the ;;; start point of the line or arc looking toward the end point, with ;;; left and negative values being on the left, center or 0.0 being ;;; directly in line, and right or positive on the right. ;;; ;;; Entering a real number equal to 1/2 of the width sets an absolute offset ;;; distance from the centerline, while specifying the same offset distance ;;; with the keywords tells the routine to change the offset distance to ;;; match 1/2 of the width, whenever it is changed. ;;; ;;; NOTE: If you wish to allow the dragline to be positioned outside ;;; of the two arcs or lines being created, you may set the local ;;; variable "dragos" = T, on the 4th line of the defun, which ;;; checks that the offset value entered is not greater or less ;;; than + or - TRACEWID / 2. ;;; ;;; You should be aware that the results of allowing this to occur ;;; may not be obvious or necessarily correct. Specifically, when ;;; drawing lines with a width of 1 and an offset of 4, if you draw ;;; segments as follows, the lines will cross back on themselves. ;;; ;;; dl 0,0,0 10,0,0 10,5 then 5,5 ;;; ;;; However, this can be quite useful for creating parallel DLINE's. ;;; ;;; dl_sao == DLine_Set_Alignment_Option ;;; (defun dl_sao (/ temp dragos) (initget "Left Center Right") (setq temp dl:osd) ;;(setq dragos T) ; See note above. (setq dl:osd (getreal (strcat "\nSet dragline position to Left/Center/Right/<Offset from center = " (rtos dl:osd) ">: " ) ) ) (cond ((= dl:osd "Left") (setq dl:aln 1 dl:osd (- (/ (getvar "tracewid") 2.0)) ) ) ((= dl:osd "Center") (setq dl:aln 0 dl:osd 0.0 ) ) ((= dl:osd "Right") (setq dl:aln 2 dl:osd (/ (getvar "tracewid") 2.0) ) ) ((= (type dl:osd) 'REAL) (if dragos (setq dl:aln nil) (progn (setq dl:aln nil) (if (> dl:osd (/ (getvar "tracewid") 2.0)) (progn (princ "\nValue entered is out of range. Reset to ") (princ (/ (getvar "tracewid") 2.0)) (setq dl:osd (/ (getvar "tracewid") 2.0)) ) ) (if (< dl:osd (- (/ (getvar "tracewid") 2.0))) (progn (princ "\nValue entered is out of range. Reset to ") (princ (- (/ (getvar "tracewid") 2.0))) (setq dl:osd (- (/ (getvar "tracewid") 2.0))) ) ) ) ) ) (T (setq dl:osd temp) ) ) ) ;;; ;;; Set a new DLINE width. ;;; ;;; dl_snw == DLine_Set_New_Width ;;; (defun dl_snw () (initget 6) (setvar "tracewid" (if (setq temp (getdist (strcat "\nNew DLINE width <" (rtos (getvar "tracewid")) ">: " ) ) ) temp (getvar "tracewid") ) ) (if dl:aln (cond ((= dl:aln 1) ; left aligned (setq dl:osd (- (/ (getvar "tracewid") 2.0))) ) ((= dl:aln 2) ; right aligned (setq dl:osd (/ (getvar "tracewid") 2.0)) ) (T (princ) ; center aligned ) ) ) ) ;;; ;;; Get an offset from a given point to the start point toward a second ;;; point. The distance between the two points is the default, but any ;;; positive distance may be entered. If a negative number is entered, ;;; it is used as a percentage distance from the "Offset from" point ;;; toward the "Offset toward" point, i.e., if -75 is entered, a point ;;; 75% of the distance between the two points listed above is returned. ;;; ;;; ;;; dl_ofs == DLine_OFfset_Startpoint ;;; (defun dl_ofs () (menucmd "s=osnapb") (initget 1) (setq strtpt (getpoint "\nOffset from: ")) (initget 1) (setq nextpt (getpoint strtpt "\nOffset toward: ")) (setq dist (getdist strtpt (strcat "\nEnter the offset distance <" (rtos (distance strtpt nextpt)) ">: " ) ) ) (setq dist (if (or (= dist "") (null dist)) (distance strtpt nextpt) (if (< dist 0) (* (distance strtpt nextpt) (/ (abs dist) 100.0)) dist ) ) ) (setq strtpt (polar strtpt (angle strtpt nextpt) dist ) ) (setq temp nil) (command "_.UNDO" "_GROUP") ) ;;; ;;; Set snap options to ON, OFF or set the size of the area to be searched ;;; by (ssget point) via "pickbox". This value is being limited for built- ;;; in display drivers at 10 pixels. For ADI drivers it may be necessary ;;; to bump up this number by adjusting "MAXSNP" at the top of this file. ;;; ;;; dl_sso == DLine_Set_Snap_Options ;;; (defun dl_sso () (initget "ON OFf Size") (setq ans (getkword "\nSet snap size or snap On/Off. Size/OFF/<ON>: " ) ) (if (= ans "OFf") (progn (setq dl:snp nil) (setvar "pickbox" 0) ) (if (= ans "Size") (progn (setq dl:snp T ans 0 ) (while (or (< ans 1) (> ans MAXSNP)) (setq ans (getint (strcat "\nNew snap size (1 - " (itoa MAXSNP) ") <" (itoa dl:opb) ">: " ) ) ) (if (or (= ans "") (null ans)) (setq ans dl:opb) ) ) (setvar "pickbox" ans) (setq dl:opb ans) ) (progn (setq dl:snp T) (setvar "pickbox" dl:opb) ) ) ) (if dl:snp (if (= uctr 0) (dl_ved "brk_e1" strtpt) ) ) (if dl_arc (setq nextpt "Arc") (setq nextpt "Line") ) ) ;;; ;;; Obtain and verify the extrusion direction of an entity at the ;;; start point or endpoint of the line or arc we are drawing. ;;; ;;; dl_ved == DLine_Verify_Extrusion_Direction ;;; (defun dl_ved (vent pt) ;; Get entity to break if the user snapped to a DLINE. ;; Make sure that it is a line or arc and that its extrusion ;; direction is parallel to the current UCS. (if (set (read vent) (ssget pt)) (progn (set (read vent) (ssname (eval (read vent)) 0)) (if (and (or (= (dl_val 0 (eval (read vent))) "ARC") (= (dl_val 0 (eval (read vent))) "LINE") ) (equal (caddr (dl_val 210 (eval (read vent)))) (caddr (trans '(0 0 1) 1 0)) 0.001 ) ) (princ) (progn (princ (strcat "\nEntity found is not an arc or line, " "or is not parallel to the current UCS. " ) ) (set (read vent) nil) ) ) ) ) (eval (read vent)) ) ;;; ;;; Verify nextpt. ;;; Get the point on the arc at the opposite ;;; end from the start point (strtpt). ;;; ;;; dl_vnp == DLine_Verify_NextPt ;;; (defun dl_vnp (/ temp cpt ang rad) (setq temp (entlast)) (if (= (dl_val 0 temp) "LINE") (setq nextpt (if (equal strtpt (dl_val 10 temp) 0.001) (dl_val 11 temp) (dl_val 10 temp) ) ) ;; Then it must be an arc... (progn ;; get its center point (setq cpt (trans (dl_val 10 temp) (dl_val -1 temp) 1) ang (dl_val 50 temp) ; starting angle rad (dl_val 40 temp) ; radius ) (setq ange (trans '(1 0 0) (dl_val -1 temp) 1) ange (angle '(0 0 0) ange) ang (+ ang ange) ) (if (> ang (* 2 pi)) (setq ang (- ang (* 2 pi))) ) (setq nextpt (if (equal strtpt (polar cpt ang rad) 0.01) (polar cpt (dl_val 51 temp) rad) (polar cpt ang rad) ) ) ) ) ) ;;; ----------------- Main Line Drawing Function ------------------- ;;; ;;; Draw the lines. ;;; ;;; dl_mlf == DLine_Main_Line_Function ;;; (defun dl_mlf (flg / temp1 temp2 newang ang1 ang2 ent cpt ang rad1 rad2 sent1 sent2 tmpt1 tmpt2 tmpt3 tmpt4) ;; Verify nextpt (if (null nextpt) (setq nextpt (dl_vnp))) (if (equal nextpt (nth 0 spts) 0.01) (if dl_arc (setq flg 4) (setq flg 3) ) ) (setq temp1 (+ (/ (getvar "tracewid") 2.0) dl:osd) temp2 (- (getvar "tracewid") temp1) newang (angle strtpt nextpt) ang1 (+ (angle strtpt nextpt) (/ pi 2)) ang2 (- (angle strtpt nextpt) (/ pi 2)) ) (cond ((= flg 1) ; if drawing lines (dl_dls nil ang1 temp1) ; Draw line segment 1 (dl_dls nil ang2 temp2) ; Draw line segment 2 ) ((or (= flg 2) (= flg 4)) ; else drawing arcs... (setq tmp (entlast) ; get the last arc entity ent (entget tmp) ; (i.e., the guideline) ;; get its center point cpt (trans (dl_val 10 tmp) (dl_val -1 tmp) 1) ang (dl_val 50 tmp) ; starting angle ) (setq ange (trans '(1 0 0) (dl_val -1 tmp) 1) ange (angle '(0 0 0) ange) ang (+ ang ange) ) (if (> ang (* 2 pi)) (setq ang (- ang (* 2 pi))) ) ;; if start angle needs revision (if (equal (angle cpt strtpt) ang 0.01) (progn ;; Start angle needs revision. (setq strt_a T rad1 (+ (dl_val 40 tmp) temp2) ; outer radius rad2 (- (dl_val 40 tmp) temp1) ; inner radius ) (setq ent (subst (cons 40 rad2) ; modify its radius (assoc 40 ent) ent ) ) (entmod ent) (dl_atl) ; Add ename to list (setq save_1 ent) (setq sent1 (dl_val -1 tmp)) (if (= flg 4) (if (> uctr 2) (dl_das 0 rad2 50) ; modify arc endpt and close ) (dl_das nil rad2 50) ; else modify arc endpt ) ;; Create the "parallel" arc (command "_.OFFSET" (getvar "tracewid") ; offset the arc (list tmp '(0 0 0)) (polar cpt ang (+ 1 rad1 rad2)) "" ) (setq tmp (entlast) ; get the offset arc ent (entget tmp) ) (dl_atl) ; Add ename to list (setq save_2 ent) (setq sent2 tmp) (if (= flg 4) (if (> uctr 3) (progn (dl_das 1 rad1 50) ; modify arc endpt and close ;; set nextpt to "CLose" which will cause an exit. (setq nextpt "CLose" v:stpt nil cont nil ) ) ) (dl_das nil rad1 50) ; else modify arc endpt ) ) (progn ; if end angle needs revision ;; End angle needs revision. (setq strt_a nil rad1 (+ (dl_val 40 tmp) temp1) ; outer radius rad2 (- (dl_val 40 tmp) temp2) ; inner radius ) (setq ent (subst (cons 40 rad1) ; modify its radius (assoc 40 ent) ent ) ) (entmod ent) (dl_atl) ; Add ename to list (setq save_1 ent) (setq sent1 (dl_val -1 tmp)) (if (= flg 4) (if (> uctr 2) (dl_das 0 rad1 51) ; modify arc endpt and close ) (dl_das nil rad1 51) ; else modify arc endpt ) ;; Create the "parallel" arc (command "_.OFFSET" (getvar "tracewid") (list tmp '(0 0 0)) cpt "" ) (setq tmp (entlast) ; get the last arc entity ent (entget tmp) ) (dl_atl) ; Add ename to list (setq save_2 ent) (setq sent2 tmp) (if (= flg 4) (if (> uctr 3) (progn (dl_das 1 rad2 51) ; modify arc endpt and close ;; set nextpt to "CLose" which will cause an exit. (setq nextpt "CLose" v:stpt nil cont nil ) ) ) (dl_das nil rad2 51) ; else modify arc endpt ) ) ) ) ((= flg 3) ; if straight closing (setq nextpt (nth 0 spts) ang1 (+ (angle strtpt nextpt) (/ pi 2)) ang2 (- (angle strtpt nextpt) (/ pi 2)) ) (dl_dls 0 ang1 temp1) (dl_dls 1 ang2 temp2) ;; set nextpt to "CLose" which will cause an exit. (setq nextpt "CLose" v:stpt nil cont nil ) ) (T (princ "\nERROR: Value out of range. ") (exit) ) ) (setq strtpt nextpt spts (append spts (list strtpt)) savpts (append savpts (list savpt3)) savpts (append savpts (list savpt4)) ) (command "_.UNDO" "_E") ; only end when DLINE's have been drawn ) ;;; ------------------- End Support Functions ----------------------- ;;; ---------------- Begin Line Drawing Functions ------------------- ;;; ;;; Straight DLINE function ;;; ;;; dl_dls == DLine_Draw_Line_Segment ;;; (defun dl_dls (flgn ang temp / j k pt1 pt2 tmp1 ent1 p1 p2) (mapcar ; get endpoints of the offset line '(lambda (j k) (set j (polar (eval k) ang temp)) ) '(pt1 pt2) '(strtpt nextpt) ) (cond ((= uctr 0) ;; Set points 1 and 2 for segment 1. (setq p1 (if (dl_l01 brk_e1 "1" pt1 pt2 strtpt) ipt savpt1)) (setq pt2 (if (dl_l01 brk_e2 "3" pt2 pt1 nextpt) ipt savpt3)) (setq pt1 p1) ) ((= uctr 1) ;; Set points 1 and 2 for segment 2. (setq p1 (if (dl_l01 brk_e1 "2" pt1 pt2 strtpt) ipt savpt2)) (setq pt2 (if (dl_l01 brk_e2 "4" pt2 pt1 nextpt) ipt savpt4)) (setq pt1 p1) ;; Now break the line or arc found at the start point ;; if there is one, and we are in a breaking mood. (if (and dl:brk brk_e1) (progn (command "_.BREAK" brk_e1 "_non" savpt1 "_non" savpt2) ) ) ;; Now break the line or arc found at the end point ;; if there is one, and we are in a breaking mood. (if (and dl:brk brk_e2) (progn (if (eq brk_e1 brk_e2) (progn ;; Delete first line so we can find the arc or line that ;; we found previously. (entdel (nth 0 wnames)) (dl_ved "brk_e2" nextpt) ;; Restore first line (entdel (nth 0 wnames)) ) ) (command "_.BREAK" brk_e2 "_non" savpt3 "_non" savpt4) ) ) ;; Do not set brk_e2 nil... it will be set later. ) ((= (rem uctr 2.0) 0) (setq fang nil) (setq p1 (dl_dl2 pt1)) ; Draw line part 2 (setq pt2 (if (dl_l01 brk_e2 "3" pt2 pt1 strtpt) ipt savpt3 ) ) (setq pt1 p1) (if flgn ; if closing (progn (setq tmp1 (nth flgn wnames) ent1 (entget tmp1) ; get the corresponding prev. entity ) (if (= (dl_val 0 tmp1) "LINE") ;; if it's a line (setq pt2 (dl_mls nil 10)) ;; if it's an arc (setq pt2 (dl_mas T nil pt2 pt1 nil)) ) ) ) ) (T (setq p1 (dl_dl2 pt1)) ; Draw line part 2 (setq pt2 (if (dl_l01 brk_e2 "4" pt2 pt1 nextpt) ipt savpt4 ) ) (setq pt1 p1) (if flgn ; if closing (progn (setq tmp1 (nth flgn wnames) ent1 (entget tmp1) ; get the corresponding prev. entity brk_e1 nil brk_e2 nil ) (if (= (dl_val 0 tmp1) "LINE") ;; if it's a line (setq pt2 (dl_mls nil 10)) ;; if it's an arc (setq pt2 (dl_mas T nil pt2 pt1 nil)) ) ) ) ;; Now break the line or arc found at the end point ;; if there is one, and we are in a breaking mood. (if (and dl:brk brk_e2) (progn (command "_.BREAK" brk_e2 "_non" savpt3 "_non" savpt4) ) ) ;; Do not set brk_e2 nil... it will be set later. ) ) (command "_.LINE" "_non" pt1 "_non" pt2 "") ; draw the line (setq wnames (if (null wnames) (list (setq elast (entlast))) (append wnames (list (setq elast (entlast)))) ) uctr (1+ uctr) ) wnames ) ;;; ;;; Set pt1 or pt2 based on whether there is an arc or line to be broken. ;;; ;;; dl_l01 == DLine_draw_Lines_0_and_1 ;;; (defun dl_l01 (bent1 n p1 p2 pt / temp) (setq n (strcat "savpt" n)) (setq spt nil) (if bent1 (if (= (dl_val 0 bent1) "LINE") (progn (setq temp (inters (trans (dl_val 10 bent1) 0 1) (trans (dl_val 11 bent1) 0 1) p1 p2 nil ) ) (if temp (set (read n) temp) (progn (set (read n) p1) (setq brk_e1 nil) ) ) ) (progn (set (read n) (dl_ial bent1 p1 p2 pt)) ;; Spt is set only if there was no intersection point. (if spt (progn (setq ipt (eval (read n))) (set (read n) spt) ) ) ) ) (set (read n) p1) ) (if spt T nil ) ) ;;; ;;; Do more of the line drawing stuff. This is where we call the modify ;;; functions for the previous arc or line segment. The line end being ;;; modified is always the group 11 end, but we have to test the start ;;; and end angle of an arc to tell which end to modify. ;;; ;;; dl_dl2 == DLine_Draw_Line_segment_part_2 ;;; (defun dl_dl2 (npt) (setq tmp1 (nth (- uctr 2) wnames) ent1 (entget tmp1) ) ; get the corresponding prev. entity (if (= (dl_val 0 tmp1) "LINE") ;; Check angles 0 180, -180 and 360... (if (or (equal (angle strtpt nextpt) (angle (trans (dl_val 10 tmp1) 0 1) (trans (dl_val 11 tmp1) 0 1) ) 0.001 ) (equal (angle strtpt nextpt) (angle (trans (dl_val 11 tmp1) 0 1) (trans (dl_val 10 tmp1) 0 1) ) 0.001 ) (equal (+ (* 2 pi) (angle strtpt nextpt)) (angle (trans (dl_val 10 tmp1) 0 1) (trans (dl_val 11 tmp1) 0 1) ) 0.001 ) ) ;; if it's a line (progn (setq brk_e2 nil) (command "_.LINE" (trans (dl_val 11 tmp1) 0 1) pt1 "") pt1 ) ;; else, if it's an arc (progn (dl_mls nil 11) ) ) ;; if it's an arc (dl_mas nil nil pt1 pt2 strtpt) ) ) ;;; ;;; Modify line endpoint ;;; ;;; dl_mls == DLine_Modify_Line_Segment ;;; (defun dl_mls (flg2 nn / spt ept pt) ; flg2 = nil if line to line ; = T if line to arc ;; This is the previous entity; a line (setq spt (trans (dl_val 10 tmp1) 0 1) ept (trans (dl_val 11 tmp1) 0 1) ) (if flg2 ;; find intersection with arc; tmp == ename of arc (progn ;; Find arc intersection with line; tmp == ename of arc. (setq pt (dl_ial tmp spt ept (if flgn nextpt strtpt))) ) ;; find intersection with line (setq pt (inters spt ept pt1 pt2 nil)) ) ;; modify the previous line (if pt (entmod (subst (cons nn (trans pt 1 0)) (assoc nn ent1) ent1 ) ) (setq pt pt2) ) pt ) ;;; ;;; This routine does a variety of tasks: it calculate the distance from ;;; the center of the arc (or congruent circle) to a line, then it ;;; calculates up to two intersection points of a line and the arc, ;;; then it attempts to determine which of the points serves as a ;;; best-fit to the following criteria: ;;; ;;; 1) One end of the arc must lie "on" the line, or ;;; one end of the line must lie on the arc. ;;; 2) Given that the point given in 1 above is p1, ;;; and that the other point is p2, then if the arc crosses over ;;; the line then use p2, otherwise the arc does not cross over ;;; the line so use p1. ;;; ;;; If the line and the arc do not intersect, then a line will be drawn ;;; from the point of intersection of the arc and the perpendicular from ;;; the line to the arc centerpoint, and the line; The line and arc will be ;;; trimmed or extended as needed to meet these points. ;;; ;;; If the line and arc are tangent, then the arc and line are ;;; trimmed/extended to this point. ;;; ;;; p1 and p2 are two points on a line ;;; ename == entity name of arc ;;; flg == T when the segment being drawn ends on an arc, ;;; flg == nil when the segment being drawn starts on an arc. ;;; ;;; dl_ial == DLine_Intersect_Arc_with_Line ;;; (defun dl_ial (arc pt_1 pt_2 npt / d pi2 rad ang nang temp ipt) (setq cpt (trans (dl_val 10 arc) (dl_val -1 arc) 1) pi2 (/ pi 2) ; 1/2 pi ang (angle pt_1 pt_2) nang (+ ang pi2) ; Normal to "ang" temp (inters pt_1 pt_2 cpt (polar cpt nang 1) nil) nang (angle cpt temp) ) ;; Get the perpendicular distance from the center of the arc to the line. (setq d (distance cpt temp)) (cond ((equal (setq rad (dl_val 40 arc)) d 0.01) ;; One intersection. (setq ipt temp) ) ((< rad d) ;; No intersection. (setq spt (polar cpt nang rad) ipt temp ) (command "_.LINE" spt ipt "") ipt ) (T ;; Two intersections. Now... ;; If drawing arcs, fang is set, we're past the first segment... ;; Reset the `near' point based on the previous ipt. This can be ;; quite different and necessary from the `npt' passed in. (if (and dl_arc fang (> uctr 1)) (setq npt (polar cpt fang rad)) ) (dl_g2p npt) (setq ipt (dl_bp arc pt_1 pt_2 ipt1 ipt2)) ;; If `fang' is not set, set it, otherwise set it to nil. (if fang (setq fang nil) (if dl_arc (setq fang (angle cpt ipt))) ) ipt ) ) ) ;;; ;;; Get two intersection points, ordering them such that ipt1 ;;; is the closer of the two points to the passed-in point "npt". ;;; ;;; dl_g2p == DLine_Get_2_Points ;;; (defun dl_g2p (npt / temp l theta) (if (equal d 0.0 0.01) (setq theta pi2 nang (+ ang pi2) ; Normal to "ang" ) (setq l (sqrt (abs (- (expt rad 2) (expt d 2)))) theta (abs (atan (/ l d))) ) ) ;; Get the two angles to the infinite intersection points of the ;; congruent circle to the arc, and the line, then get the two ;; intersection points. (setq ipt1 (polar cpt (- nang theta) rad)) (setq ipt2 (polar cpt (+ nang theta) rad)) ;; Set the closer of the two points to npt to be ipt1. (if (< (distance ipt2 npt) (distance ipt1 npt)) ;; Swap points (setq temp ipt1 ipt1 ipt2 ipt2 temp ) (if (equal (distance ipt2 npt) (distance ipt1 npt) 0.01) (exit) ) ) ipt1 ) ;;; ;;; Test a point `pt' to see if it is on the line `sp--ep'. ;;; ;;; dl_onl == DLine_ON_Line_segment ;;; (defun dl_onl (sp ep pt / cpt sa ea ang) (if (inters sp ep pt (polar pt (+ (angle sp ep) (/ pi 2)) (/ (getvar "tracewid") 10) ) T ) T nil ) ) ;;; ;;; Test a point `pt' to see if it is on the arc `arc'. ;;; ;;; dl_ona == DLine_ON_Arc_segment ;;; (defun dl_ona (arc pt / cpt sa ea ang) (setq cpt (trans (dl_val 10 arc) (dl_val -1 arc) 1) sa (dl_val 50 arc) ; angle of current ent start point ea (dl_val 51 arc) ; angle of current ent end point ang (angle cpt pt) ; angle to pt. ) (if (> sa ea) (if (or (and (> ang sa) (< ang (+ ea (* 2 pi)))) (and (> ang (- ea (* 2 pi))) (< ang ea)) ) T nil ) (if (and (> ang sa) (< ang ea)) T nil) ) ) ;;; ;;; Get the best intersection point of an arc and a line. The criteria ;;; are as follows: ;;; ;;; 1) The best point will lie on both the arc and the line. ;;; 2) It will be the point which causes the shortest arc to be created ;;; such that (1) is satisfied. ;;; 3) If closing, then always use the point closest to nextpt. Unless, ;;; the points are equidistant, then use 1 and 2 above to tiebreak. ;;; 4) If breaking an arc with a line, always use the points nearest the ;;; break point. ;;; ;;; dl_bp == DLine_Best_Point_of_arc_and_line ;;; (defun dl_bp (en1 p1 p2 pp1 pp2 / temp temp1 temp2) (setq temp1 (dl_onl p1 p2 pp2) temp2 (dl_ona en1 pp2) temp (if (or (= flg 1) (= flg 3)) T nil) ) (if (and temp1 temp2) (if (and (< uctr 2) (and brk_e1 brk_e2) ) pp1 (if (and temp (not fang)) pp1 pp2) ) pp1 ) ) ;;; ----------------- End Line Drawing Functions -------------------- ;;; ---------------- Begin Arc Drawing Functions ------------------- ;;; ;;; Draw curved DLINE ;;; ;;; dl_das == DLine_Draw_Arc_Segment ;;; (defun dl_das (flgn orad nn / tmp1 ent1 pt ang) (cond ((= uctr 0) (setq sent1 tmp) (dl_a01 brk_e1 "1" strtpt nil) ; DLine_draw_Arc_0_and_1 (dl_a01 brk_e2 "3" nextpt T) ; DLine_draw_Arc_0_and_1 ) ((= uctr 1) (setq sent1 tmp) (dl_a01 brk_e1 "2" strtpt nil) ; DLine_draw_Arc_0_and_1 (dl_a01 brk_e2 "4" nextpt T) ; DLine_draw_Arc_0_and_1 (dl_mae nil T) (dl_mae nil nil) ;; Now break the line or arc found at the start point ;; if there is one, and we are in a breaking mood. (if (and dl:brk brk_e1) (progn (dl_mae T T) (dl_mae T nil) (command "_.BREAK" brk_e1 savpt1 savpt2) ) ) ;; Do not set brk_e1 nil... it will be set later. ;; Now break the line or arc found at the end point ;; if there is one, and we are in a breaking mood. (if (and dl:brk brk_e2) (progn (if (eq brk_e1 brk_e2) (progn ;; Delete both arcs so we can find the arc or line that ;; we found previously. (entdel (nth 0 wnames)) (entdel (nth 1 wnames)) (dl_ved "brk_e2" nextpt) ;; Restore first line (entdel (nth 0 wnames)) (entdel (nth 1 wnames)) ) ) (if (null brk_e1) (progn (dl_mae T T) (dl_mae T nil) ) ) (command "_.BREAK" brk_e2 savpt3 savpt4) ) ) ;; Do not set brk_e2 nil... it will be set later. ) ((= (rem uctr 2.0) 0) (setq fang nil) (dl_da2) ; Draw arc part 2 (if fang (setq ftmp fang fang nil ) ) (setq save_1 ent) (setq sent1 (cdr (assoc -1 ent))) (setq pt2 (dl_a01 brk_e2 "3" nextpt T)) ; DLine_draw_Arc_0_and_1 (if ftmp (setq fang ftmp ftmp nil ) ) ) (T (dl_da2) ; Draw arc part 2 (if fang (setq ftmp fang fang nil ) ) (setq save_2 ent) (setq sent1 (cdr (assoc -1 ent))) (setq pt2 (dl_a01 brk_e2 "4" nextpt T)) ; DLine_draw_Arc_0_and_1 (if ftmp (setq fang fang ftmp nil ) ) ;; Now break the line or arc found at the end point ;; if there is one, and we are in a breaking mood. (if (and dl:brk brk_e2) (progn (dl_mae T T) (dl_mae T nil) (command "_.BREAK" brk_e2 savpt3 savpt4) ) ) ;; Do not set brk_e2 nil... it will be set later. ) ) (setq uctr (1+ uctr)) ) ;;; ;;; Set pt1 or pt2 based on whether there is an arc or line to be broken. ;;; ;;; dl_a01 == DLine_draw_Arcs_0_and_1 ;;; (defun dl_a01 (bent1 n pt flg / pt1 pt2 ang1 ang2 anga angb) ;; "n" is the point to save for end capping (setq n (strcat "savpt" n)) ;; "tmp" is the arc just created. ;; "bent1" is the line or arc to be broken, if there is one... (if bent1 (if (= (dl_val 0 bent1) "LINE") (progn (set (read n) (dl_ial tmp (trans (dl_val 10 bent1) 0 1) (trans (dl_val 11 bent1) 0 1) pt ) ) ) (progn (setq curcpt (trans (dl_val 10 sent1) (dl_val -1 sent1) 1) prvcpt (trans (dl_val 10 bent1) (dl_val -1 bent1) 1) pt1 (polar prvcpt (dl_val 50 bent1) (dl_val 40 bent1)) pt2 (polar curcpt (dl_val nn sent1) (dl_val 40 sent1)) ang1 (angle prvcpt pt1) ) (if (not (equal ang1 (angle prvcpt strtpt) 0.01)) (setq pt1 (polar prvcpt (dl_val 51 bent1) (dl_val 40 bent1)) ang1 (angle prvcpt pt1) ang2 (angle curcpt pt2) anga (- ang1 ang2) angb (- ang2 ang1) ) ) (if (or (and (< anga 0.0872665) (> anga -0.0872665) ) (and (< angb 0.0872665) (> angb -0.0872665) ) ) (progn (set (read n) pt) (if (= bent1 brk_e1) (setq brk_e1 nil) (setq brk_e2 nil) ) ) (set (read n) (dl_iaa sent1 bent1 pt flg)) ) ) ) (progn (setq cpt (trans (dl_val 10 tmp) (dl_val -1 tmp) 1)) (set (read n) (polar cpt (angle cpt pt) orad)) ) ) (eval (read n)) ) ;;; ;;; Do more of the arc drawing stuff. This is where we call the modify ;;; functions for the previous arc or line segment. The line end being ;;; modified is always the group 11 end, but we have to test the start ;;; and end angle of an arc to tell which end to modify. ;;; ;;; dl_da2 == DLine_Draw_Arc_segment_part_2 ;;; (defun dl_da2 (/ pt) ;; get the corresponding previous entity (setq tmp1 (nth (- uctr 2) wnames) ent1 (entget tmp1) ) (if (= (dl_val 0 tmp1) "LINE") ;; if it's a line (setq pt (dl_mls T 11)) ;; if it's an arc (setq pt (dl_mas nil T nil nil strtpt)) ) ;; pt is a point in the current UCS, not ECS (if pt (progn (setq ang (- (angle cpt pt) ange)) (entmod (setq ent (subst (cons nn ang) (assoc nn ent) ent ) ) ) ; modify arc endpt ) ) (if flgn ; if closing (progn (setq tmp1 (nth flgn wnames) ent1 (entget tmp1) ) ; get the flagged entity (if (= (dl_val 0 tmp1) "LINE") ;; if it's a line (setq pt (dl_mls T 10)) ;; if it's an arc (setq pt (dl_mas T T nil nil nextpt)) ) (if pt (progn (setq ang (- (angle cpt pt) ange)) (setq nn (if (= nn 50) 51 50)) (entmod (setq ent (subst (cons nn ang) (assoc nn ent) ent ) ) ) ; modify arc endpt ) ) ) ) ) ;;; ;;; Modify the endpoints of an arc by changing the start and end angles. ;;; ;;; dl_mae == DLine_Modify_Arc_Endpoints ;;; (defun dl_mae (eflg sflg / nn1 nn2) (if (= nn 50) (setq nn1 50 nn2 51 ) (setq nn1 51 nn2 50 ) ) (if sflg (if eflg (setq save_1 (subst (cons nn2 (angle (trans cpt 1 (cdr (assoc -1 save_1))) (trans savpt3 1 (cdr (assoc -1 save_1))) ) ) (assoc nn2 save_1) save_1 ) ) (setq save_1 (subst (cons nn1 (angle (trans cpt 1 (cdr (assoc -1 save_1))) (trans savpt1 1 (cdr (assoc -1 save_1))) ) ) (assoc nn1 save_1) save_1 ) ) ) (if eflg (setq save_2 (subst (cons nn2 (angle (trans cpt 1 (cdr (assoc -1 save_1))) (trans savpt4 1 (cdr (assoc -1 save_2))) ) ) (assoc nn2 save_2) save_2 ) ) (setq save_2 (subst (cons nn1 (angle (trans cpt 1 (cdr (assoc -1 save_1))) (trans savpt2 1 (cdr (assoc -1 save_2))) ) ) (assoc nn1 save_2) save_2 ) ) ) ) (if sflg (entmod save_1) (entmod save_2) ) ) ;;; ;;; Modify arc ; flg2 = nil if arc to line ;;; ; = T if arc to arc ;;; ;;; dl_mas == DLine_Modify_Arc_Segment ;;; (defun dl_mas (flg3 flg2 spt ept pt / nnn pt1 pt2 rad1 ange) ;; get some stuff (setq cpt1 (trans (dl_val 10 tmp1) (dl_val -1 tmp1) 1) rad1 (dl_val 40 tmp1) ang1 (dl_val 50 tmp1) ) (if (null pt) ; if a point is not passed in: (setq pt (nth 0 spts)) ; set to initial saved start point. ) (setq ange (trans '(1 0 0) (dl_val -1 tmp1) 1) ange (angle '(0 0 0) ange) ang1 (+ ang1 ange) ) (if (> ang1 (* 2 pi)) (setq ang1 (- ang1 (* 2 pi))) ) (if (equal (angle cpt1 pt) ang1 0.01) ; figure out if we're looking (setq nnn 50) ; for the start or end point of (setq nnn 51) ; the beginning arc, then ) ; get the intersection point ;; if arc to arc (if flg2 ;; then (progn ;; find intersection with arc (setq pt1 (dl_iaa tmp tmp1 (if flg3 nextpt strtpt) flg2)) (if pt1 (progn (setq ang1 (- (angle cpt1 pt1) ange)) (setq ent1 (subst (cons nnn ang1) (assoc nnn ent1) ent1 ) ) (entmod ent1) ; modify arc endpt ) ) ) ;; else (progn ;; find arc intersection with line from spt to ept (setq pt1 (dl_ial tmp1 spt ept pt)) (setq ang1 (- (angle cpt1 pt1) ange)) (setq ent1 (subst (cons nnn ang1) (assoc nnn ent1) ent1 ) ) (entmod ent1) ; modify arc endpt ) ) pt1 ) ;;; ---------------- Begin Arc to Arc Functions --------------------- ;;; ;;; This routine does a variety of tasks: it calculate up to two ;;; intersection points of two arcs, ;;; then it attempts to determine which of the points serves as a ;;; best-fit to the following criteria: ;;; ;;; 1) One end of the arc must lie "on" the arc. ;;; 2) Given that the point given in 1 above is pt1, ;;; and that the other point is pt2, then if the arc crosses over ;;; the other arc then use pt2, otherwise the arc does not cross over ;;; the other arc so use pt1. ;;; ;;; If the two arcs do not intersect, then a line will be drawn ;;; from the point of intersection of the arc and the perpendicular from ;;; the line of the two arc centerpoints; The arcs will be ;;; trimmed or extended as needed to meet these points. ;;; ;;; If the two arcs are tangent, then they are ;;; trimmed/extended to this point. ;;; ;;; Intersection point of two arcs or circles ;;; a = radius of ename 1 ;;; b = distance from curcpt to prvcpt ;;; c = radius of ename 2 ;;; curcpt = center point of first circle or arc -- bent1, bent2, tmp ;;; prvcpt = center point of second circle or arc -- sent1, sent2, tmp1 ;;; npt = near point for nearest test ;;; ;;; dl_iaa == DLine_Intersect_Arc_and_Arc ;;; (defun dl_iaa (en1 en2 npt flga / a b c s ang alpha alph ipt curcpt prvcpt temp temp1 temp2) (setq curcpt (trans (dl_val 10 en1) (dl_val -1 en1) 1) ; the "last" entity prvcpt (trans (dl_val 10 en2) (dl_val -1 en2) 1) ; the previous entity a (dl_val 40 en2) b (distance curcpt prvcpt) c (dl_val 40 en1) s (/ (+ a b c) 2.0) ang (angle curcpt prvcpt) ) (cond ;; circles are tangent ;; If (- s a) == 0, this would cause a divide by zero below... ((or (= (- s a) 0) (equal b (+ a c) 0.001) (equal b (abs (- a c)) 0.001)) ;; Circles are tangent. (setq ipt nil) ) ;; circles do not intersect ((and (or (> b (+ a c)) (if (> c a) (< (+ a b) c) (< (+ c b) a))) (not (equal (+ a b) c (/ (+ a b c) 1000000))) ) ;; No intersection. (if (= flg 4) (progn (setq ipt (polar curcpt (angle curcpt prvcpt) c)) (command "_.LINE" (polar prvcpt (angle prvcpt ipt) a) ipt "") ) (progn (setq ipt (polar curcpt (angle curcpt prvcpt) c)) (command "_.LINE" (polar prvcpt (angle prvcpt ipt) a) ipt "") ) ) ) (T ;; general law of cosines formula -- (- s a) != 0 (setq alpha (* 2.0 (atan (sqrt (abs (/ (* (- s b) (- s c)) (* s (- s a)) ) ) ) ) ) ) (setq tpt1 (polar curcpt (+ ang alpha) c) tpt2 (polar curcpt (- ang alpha) c) anga (angle curcpt npt) angb (angle prvcpt npt) ) ;; Two intersections. Now... ;; If drawing arcs, fang is set, we're past the first segment... ;; Reset the `near' point based on the previous ipt. This can be ;; quite different and necessary from the `npt' passed in. (if (and dl_arc fang (> uctr 1)) (setq npt (polar prvcpt fang c)) ) (if (< (distance tpt1 npt) (distance tpt2 npt)) (setq temp tpt1 tpt1 tpt2 tpt2 temp ) ) (setq temp (angle prvcpt curcpt)) ; angle from prev ent to this ent (setq ipt (dl_bap en1 en2 tpt2 tpt1 nil)) (if fang (setq fang nil) (if dl_arc (setq fang (angle cpt ipt))) ) ) ) (setq cpt curcpt) (setq cpt1 prvcpt) ipt ; return point ) ;;; ;;; Get the best point for the arc/arc intersection. ;;; ;;; dl_bap == DLine_Best_Point_to_Arc ;;; (defun dl_bap (en1 en2 pp1 pp2 flg / temp1 temp2) (setq temp1 (dl_ona en1 pp2) temp2 (dl_ona en2 pp2) ) (if temp2 (if (and (< uctr 2) (and brk_e1 brk_e2) ) pp1 (if temp1 (if (< uctr 2) pp2 (if (not fang) pp2 pp1) ) pp1 ) ) pp1 ) ) ;;; ----------------- End Arc Drawing Functions -------------------- ;;; -------------------- Begin Misc Functions ----------------------- ;;; ;;; Add the entity name to the list in wnames. ;;; ;;; dl_atl == DLine_Add_To_List ;;; (defun dl_atl () (setq wnames (if (null wnames) (list (entlast)) (append wnames (list tmp)) ) ) wnames ) ;;; ;;; The value of the assoc number of <ename> ;;; (defun dl_val (v temp) (cdr (assoc v (entget temp))) ) ;;; ;;; List stripper : strips the last "v" members from the list ;;; (defun dl_lsu (lst v / m) (setq m 0 temp '() ) (repeat (- (length lst) v) (progn (setq temp (append temp (list (nth m lst)))) (setq m (1+ m)) ) ) temp ) ;;; ;;; Bitwise DLINE endcap setting function. ;;; (defun endcap () (initget "Auto Both End None Start") (setq dl:ecp (getkword "\nDraw which endcaps? Both/End/None/Start/<Auto>: " ) ) (cond ((= dl:ecp "None") (setq dl:ecp 0) ) ((= dl:ecp "Start") (setq dl:ecp 1) ) ((= dl:ecp "End") (setq dl:ecp 2) ) ((= dl:ecp "Both") (setq dl:ecp 3) ) (T ; Auto (setq dl:ecp 4) ) ) ) ;;; ;;; Set these defaults when loading the routine. ;;; (if (null dl:ecp) (setq dl:ecp 4)) ; default to auto endcaps (if (null dl:snp) (setq dl:snp T)) ; default to snapping ON (if (null dl:brk) (setq dl:brk T)) ; default to breaking ON (if (null dl:osd) (setq dl:osd 0)) ; default to center alignment ;;; ;;; These are the c: functions. ;;; (defun c:dl () (dline)) (defun c:dline () (dline)) (princ " DLINE loaded.") (princ) ;; (c:dline) ;; Unblock for testing

Trusted paths are a bit of BS in aussie terms as from a programming point of view you can add trusted paths. Its more nuisance than really providing a security check. I use Bricscad mainly and it does not have trusted paths. Makes life easier. I have a setup lisp that is used when say installing a new version it has the support paths and trusted paths pre set as well as setting lots of other stuff like adding custom mnu's.

Options>Files>Trusted Paths You need to include the path to the LISP folder.

This program is very old (13 years in fact); I'll look to update it to incorporate a tag prompt (if multiple tags are found in the selection) as & when I have time.

For reference, the syntax for the edtime DIESEL function may be found here - https://help.autodesk.com/view/ACD/2025/ENU/?guid=GUID-F94A885A-4DA2-432B-AC1A-EB49CC6C1C72

Thank you @pkenewell for testing its odd that it works fine in Bricscad, I will update my saved version. thanks again.

You'll need to load the LISP LM:str->lst - it is one of Lee Macs, from his website String to List

Your structural drawing is in Model Space while your title block/border and viewport are in Paper Space. Am I right on both counts? If so, you can set the viewport scale to 1/4"=1'-0" and your building should fit within its confines. The scale factor I mention is fairly typical of architectural drawings. If you are satisfied with the results make sure to lock the viewport scale so you don't inadvertently change it.

@3dwannab FWIW - Here is how I would re-write @BIGAL's code above to have some basic error handling to prevent an invalid MLINESTYLE from being created (Yes - I found out it will create an MLINESTYLE with no elements). (defun c:MAKMLSTYLE (/ des i lst mle mln off) (setq mln (getstring "\nEnter a name of the MLINE Style: ") des (getstring t "Enter a Description for the MLINE Style:") des (if (= des "") mln des) ) (while (setq off (getreal "\nEnter MLINE Offsets one value at a time, then ENTER to continue: " )) (setq lst (cons off lst)) ) (if (and (/= mln "") lst (> (length lst) 1)) (progn (setq mle (list '(0 . "MLINESTYLE") '(100 . "AcDbMlineStyle") (cons 2 mln) (cons 70 (+ 16 256)) (cons 3 des) '(62 . 256) (cons 51 (/ pi 2.)) (cons 52 (/ pi 2.)) (cons 71 (setq i (length lst))) ) ) (repeat i (setq mle (append mle (list (cons 49 (nth (setq i (1- i)) lst)) (cons 62 256) (cons 6 "BYLAYER") ) ) ) ) (if (not (dictadd (cdar (dictsearch (namedobjdict) "ACAD_MLINESTYLE")) mln (entmakex mle))) (Alert (strcat "Unable to create MLINESTYLE \"" mln "\"\nThe Style May already Exist.")) (progn (Princ (strcat "\nMLINESTYLE \"" mln "\" Created.")) (setvar 'cmlstyle mln) ) ) ) (progn (if (= mln "")(Princ "\nYou must provide a Name for the MLINESTYLE. ")) (if (< (Length lst) 2)(princ "\nThe MLINESTYLE must have at least 2 elements.")) ) ) (princ) )

I have moved your thread to the AutoLISP, Visual LISP & DCL Forum. Please post in the correct forum.

I allways use (alert (strcat "whatever : " (vl-princ-to-string whoever))) , even if whoever is nil , alert function still alerts. sorry I have no time to respond more because my agency asked me to help one of its clients with a problem while my dayjob is also quite intense at this moment (end of year stress) so I work from 6am till 5pm for dayjob and 6pm to 0.00am for the other job (and this 24/7 , a couple of weeks in a row so far) I wrote (of course) an app for the second job but it took me 2 whole weekends , starting friday from 6pm and 'finished' on sunday 10pm , only left my cave for food and sanitary stops. Hope to finish the second job this week / weekend so next week I only have day job left , no pressure haha. Don't think I'll ever gonna take on two jobs at the same time any time soon.

I am using Bricscad V24 soon V25. Anybody else using 2025 that can maybe test I don't have 2025.

A quick google and found by Lee-mac a solution, a further edit by Codeding added page sizes. Google is your friend. But must use correct syntax. "lee-mac get number of pages in pdf autocad lisp" Any way https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/insert-pdf-pages-help/td-p/9890051

Not sure about how to get a subtotal of a specific size of page. You get the grand total by default. This page seems to have the instructions for inserting a link. To summarize, go to Navigation | Edit | Link | Auto Page Links. Scan the area to link. Press Create.

"it depends on which "direction" the polylines are drawn" the code above is almost there, what I use and have done so for like 30+ years, is pick an object end, this returns 3 points the pick point, start & end you compare the distance of pt->end pt->start and can then work out if need to reverse the line or pline, NOTE Bricscad does not have Reverse, have not checked V25. Reverse "This is not a BricsCAD command. Have you tried PEDIT with the suboption Reverse direction?" An example this would be a line answer. (setq ent (entsel "\nPIck object near end Enter to exit ")) (setq pt (cadr ent)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent))))) (setq obj2 (vlax-ename->vla-object (car ent))) (setq start (vlax-curve-getstartPoint obj2)) (setq end (vlax-curve-getendPoint obj2)) (setq d1 (distance pt start)) (setq d2 (distance pt end)) (if (> d1 d2) (setq tmp start start end end tmp )

In a layout you can get the viewports, (ssget "X" '((0 . "VIEWPORT")(cons 410 (getvar 'ctab)))) the 410 restricts to the current layout tab. if you have 2 Mviews the ssget will return 3 viewports as Pspace is the first viewport. So you can set a viewport as current, now where is it, then using lisp do the vplayer.

Agree with Steven start small, no good asking for I want a BOQ for my 30Mb dwg. Some code can end up like 1000 lines. There is a tutorial included with a Acad called "down the garden path". I think its down in samples directory. There are electronic books out there, look on kindle, another is Afralisp has good tutorials. So ask about a task we can provide the steps involved without providing code so you can have a go. Be aware CHATGP & Copilot will write lisp code some times its ok but often it is not usable. Lastly get a copy of Notepad++ a great editor for lisp code.

The AutoCAD right click menu - make it your own! - Autodesk Community

If you don't understand the code ask, most people will add explanations line by line. Explaining what is going on. Big list of VLA functions attached then just google what your maybe trying to understand. Sorry no author name in the Autolisp functions. The_Visual_LISP_Developers_Bible.pdf Books such as by Reonaldo Togeros, can get on Kindle as Ebook nice thing is can copy and paste code. List of all vl commands.txt AUTOLISP FUNCTIONS CATOGRIZATION.pdf

Thanks SLW - sure determination to make it work though from me I'll have a look at the hatchedit to see why it might not work in other CADS slight change to the above, see if it works

And then stolen, I mean copied for our convenience....

LISP I wrote to include the common filters (I still use QSelect, but generally this si all I need and it's a lot faster than the QSelect menu)... eg. Command: ft Filter choice: [block/Color/Entity/Layer/linetYpe] <Layer>: FilteredSelection.LSP

I enjoy writing the programs and figure they are useless just sitting on my hard drive...