(defun C:TLMK ( / TLMK_LEN PT1)
(setvar "CMDECHO" 0)
(setq tempunits (getvar "insunits"))
;======================================================================================================================================== LOADS DIALOG BOX
(defun TLMK(/ DCL_ID)
(setq DCL_ID (load_dialog "n:/tuterj/AutoLISP/Working/TL-MK_Scale_add.DCL"))
(if (not (new_dialog "TLMK" DCL_ID)) (exit))
(setq mark_n nil)
(setq title_n nil)
(action_tile "cancel" "(done_dialog) (exit)")
(action_tile "mark_n" "(setq mark_n $value)")
(action_tile "title_n" "(setq title_n $value)")
(start_dialog)
(unload_dialog DCL_ID)
(princ)
) ;defun TLMK
(TLMK)
;======================================================================================================================================== End of Dialog BOx
[color=red](vl-load-com)
(setq vpent (car (nentsel "\nselect viewport"))) ;user selects viewport and viewport id is stored under vpent
(vlax-ename->vla-object vpent) ;vpent is transformed from an entity to a VLA object
(setq scale_fld (strcat "%<\AcObjProp.16.2 Object(%<\_ObjId "(vl-princ-to-string(vla-get-Objectid vpent))">%).CustomScale \f\"%sn\">%")) ;assigns field expression to variable.[/color]
(setq PT1 (getpoint "\nselect insertion point: "))
(setvar "ATTDIA" 0)
(setq title_u (strcase title_n)) ;declaring additional variable to change case for title_n
(setvar "insunits" 0) ;setting insertion units to unitless for proper scale of inserted block
(command "insert" "N:/Tuterj/AutoLISP/Working/TitleMark-field.dwg" PT1 "" "" title_u scale_fld mark_n) ;inserting the contents of TitleMark drawing and inserting user input from dialog box.
(setvar "ATTDIA" 1)
(setvar "CMDECHO" 1)
(setvar "insunits" tempunits)
) ;defun C:TLMK
(vlax-ename->vla-object vpent)
And this should be:(setq vpent (vlax-ename->vla-object vpent))
(setq vpent (car (nentsel "\nselect viewport"))) ;user selects viewport and viewport id is stored under vpent
(setq vpent (vlax-ename->vla-object vpent)) ;vpent is transformed from an entity to a VLA object
(setq scale_fld (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "(vl-princ-to-string(vla-get-Objectid vpent))">%).CustomScale \\f \"%sn\">%")) ;assigns field expression to variable.
;; ObjectID - Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:ObjectID ( obj )
(eval
(list 'defun 'LM:ObjectID '( obj )
(if
(and
(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:ObjectID obj)
)
k.
(defun gc:GetObjectIdString (obj) ;By Gile via Tharwat from AUGI
(or *util*
(setq *util* (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))
);vla-get-utility
);setq *util*
);or *util*
(if (vlax-method-applicable-p *util* 'GetObjectIdString)
(vla-GetObjectIdString *util* obj :vlax-false)
(itoa (vla-get-ObjectId obj))
);if
);defun gc:GetObjectIdString
(setq scale_fld (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "(gc:GetObjectIdString vpent)">%).CustomScale \\f \"%sn\">%")) ;assigns field expression to variable.
(defun _selvp (ename)
(if (= (type ename) 'ename)
(cond ((= "VIEWPORT" (cdr (assoc 0 (entget ename)))) ename)
((and (setq ename (cdr (assoc 330 (entget ename))))
(= "VIEWPORT" (cdr (assoc 0 (entget ename))))
)
ename
)
)
)
)
(_selvp (car (entsel)))
(ssget "_+.:E:S" '((0 . "VIEWPORT")))
Or just:Leave it to me to over think. .. That's why you get paid the big bux. :-DCode: [Select](ssget "_+.:E:S" '((0 . "VIEWPORT")))
This should help with non rectangular viewport selection:Code: [Select](defun _selvp (ename)
(if (= (type ename) 'ename)
(cond ((= "VIEWPORT" (cdr (assoc 0 (entget ename)))) ename)
((and (setq ename (cdr (assoc 330 (entget ename))))
(= "VIEWPORT" (cdr (assoc 0 (entget ename))))
)
ename
)
)
)
)
(_selvp (car (entsel)))
Or just:Code: [Select](ssget "_+.:E:S" '((0 . "VIEWPORT")))
;File Name: Title_Mark_Scale_add.LSP
;Description: Initiate and populate Title Mark Block & select viewport to populate scale
;
;Designed by: Mike Tuter
;Date: 01-08-2014
;Updated:
;Info: Launch from the MDC Plan Sheet tool Palette and intiate the populating and placement of the Title Mark block.
; User will provide input to dialog box for mark number and title, then user will be prompted to select a viewport
; Once a viewport is selected user will be prompted for an insertion point where the title mark block will be inserted
; and populated with the information from the dialog box and the scale from the viewport selection.
;
;
;Combined Programs:
;
;-----------------------------------------------------------------------------------------------------------------------------------------------------
(defun C:TLMK ( / TLMK_LEN PT1)
(setvar "CMDECHO" 0)
(setq tempunits (getvar "insunits"))
;======================================================================================================================================== LOADS DIALOG BOX
(defun TLMK(/ DCL_ID)
(setq DCL_ID (load_dialog "n:/tuterj/AutoLISP/Working/TL-MK_Scale_add.DCL"))
(if (not (new_dialog "TLMK" DCL_ID)) (exit))
(setq mark_n nil)
(setq title_n nil)
(action_tile "cancel" "(done_dialog) (exit)")
(action_tile "mark_n" "(setq mark_n $value)")
(action_tile "title_n" "(setq title_n $value)")
(start_dialog)
(unload_dialog DCL_ID)
(princ)
) ;defun TLMK
(TLMK)
;======================================================================================================================================== End of Dialog BOx
(vl-load-com)
(defun _selvp (ename) ;function to account for polygonal viewports by ronjonp from the swamp
(if (= (type ename) 'ename)
(cond ((= "VIEWPORT" (cdr (assoc 0 (entget ename)))) ename)
((and (setq ename (cdr (assoc 330 (entget ename))))
(= "VIEWPORT" (cdr (assoc 0 (entget ename))))
);and
ename
);((and
);(cond
);(if
);(defun
(setq vpent (_selvp (car (nentsel "\nselect viewport")))) ;user selects viewport and viewport id is stored under vpent
(setq vpent (vlax-ename->vla-object vpent)) ;vpent is transformed from an entity to a VLA object
(defun gc:GetObjectIdString (obj) ;By Gile via Tharwat from AUGI. This function deals with having a 64 bit OS.
(or *util*
(setq *util* (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))
);vla-get-utility
);setq *util*
);or *util*
(if (vlax-method-applicable-p *util* 'GetObjectIdString)
(vla-GetObjectIdString *util* obj :vlax-false)
(itoa (vla-get-ObjectId obj))
);if
);(defun gc:GetObjectIdString
(setq scale_fld (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "(gc:GetObjectIdString vpent)">%).CustomScale \\f \"%sn\">%")) ;assigns field expression to variable.
(setq PT1 (getpoint "\nselect insertion point: "))
(setvar "ATTDIA" 0)
(setq title_u (strcase title_n)) ;declaring additional variable to change case for title_n
(setvar "insunits" 0) ;setting insertion units to unitless for proper scale of inserted block
(command "insert" "N:/Tuterj/AutoLISP/Working/TitleMark-field.dwg" PT1 "" "" title_u scale_fld mark_n) ;inserting the contents of TitleMark drawing, user input from dialog box, &
;the viewport scale infromation from the user selection.
(setvar "ATTDIA" 1)
(setvar "CMDECHO" 1)
(setvar "insunits" tempunits)
) ;defun C:TLMK
Or just:Code: [Select](ssget "_+.:E:S" '((0 . "VIEWPORT")))
Or just:Lee Mac, thank you as well for your reply! I tried inserting this into my routine and it did not work, but I believe it is because I did not insert this piece of code in the correct spot. Where should I have put this code in the overall structure of my program?Code: [Select](ssget "_+.:E:S" '((0 . "VIEWPORT")))
(setq vpent (_selvp (car (nentsel "\nselect viewport"))))
With:(setq vpent (ssname (ssget "_+.:E:S" '((0 . "VIEWPORT"))) 0))
However, note that this does not include error trapping to allow for the user failing to select a Viewport, for which the program will currently error.;; Example program written for Swamp thread:
;; http://www.theswamp.org/index.php?topic=45993.0
;; by Lee Mac 2014-01-14
(defun c:tlmk ( / *error* blk dch dcl dwg mark_n sel title_n val var )
(setq dwg "N:/Tuterj/AutoLISP/Working/TitleMark-field.dwg" ;; Block to insert
dcl "N:/tuterj/AutoLISP/Working/TL-MK_Scale_add.dcl" ;; DCL file
)
(defun *error* ( msg )
(mapcar 'setvar var val)
(if (< 0 dch) (unload_dialog dch))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(cond
( (not
(or (tblsearch "block" (setq blk (vl-filename-base dwg)))
(setq blk (findfile dwg))
)
)
(princ (strcat "\n" dwg " file not found."))
)
( (<= (setq dch (load_dialog dcl)) 0)
(princ (strcat "\n" dcl " file not found."))
)
( (not (new_dialog "TLMK" dch))
(princ (strcat "\n" dcl " file contains an error, dialog could not be loaded."))
)
( t
(action_tile "mark_n" "(setq mark_n $value)")
(action_tile "title_n" "(setq title_n $value)")
(action_tile "accept"
(vl-prin1-to-string
'(cond
( (null mark_n)
(alert "Please enter a value for the mark_n tile.")
(mode_tile "mark_n" 2)
)
( (null title_n)
(alert "Please enter a value for the title_n tile.")
(mode_tile "title_n" 2)
)
( (done_dialog 1))
)
)
)
(if (= 1 (start_dialog))
(if (setq sel (LM:ssget "\nSelect viewport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
(progn
(setq var '(cmdecho insunits attreq)
val (mapcar 'getvar var)
)
(mapcar 'setvar var '(0 0 1))
(princ "\nSpecify insertion point for block: ")
(vl-cmdf "_.-insert" blk "_S" 1.0 "_R" 0.0 "\\"
(strcase title_n)
(strcat
"%<\\AcObjProp.16.2 Object(%<\\_ObjId "
(LM:objectid (vlax-ename->vla-object (ssname sel 0)))
">%).CustomScale \\f \"%sn\">%"
)
mark_n
)
(mapcar 'setvar var val)
)
)
(princ "\n*Cancel*")
)
)
)
(if (< 0 dch) (setq dch (unload_dialog dch)))
(princ)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; ObjectID - Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:objectid ( obj )
(eval
(list 'defun 'LM:objectid '( obj )
(if
(and
(wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
(vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:objectid obj)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
Or just:Lee Mac, I have been looking at your code here and trying to get it to work in my routine, but with no sucess yet. One question I had was what mode does the "_+.:E:S" represent for the selection set get function?Code: [Select](ssget "_+.:E:S" '((0 . "VIEWPORT")))
(setq var '(cmdecho insunits attreq)) ;set a variable 'var' which is a list to contain the sysvars to be modified
(setq val (mapcar 'getvar var)) ;set a variable 'val' which holds the values when mapcar applies the "getvar" command to each item in the 'var' list
(mapcar 'setvar var '(0 0 1)) ;so we're mapping "setvar" over the var list this time, with quoted 0 0 1, so basically it's a shorthand way to express the following:
; (setvar "cmdecho" 0) (setvar "insunits" 0) (setvar "attreq" 1), this has the added benefit of when you're ready to expand this list to contain
;more variables you can do so by typing the sysvar name and the value wanted for that var, much easier than even the typical commands
;to set and store user settings beforehand.
My only question that I've noticed when seeing this use of mapcar is where are the users original settings stored? If the program is modifying attreq to do it's duty, shouldn't attreq be put back to what it's value was before the program was initiated ? ...
(defun c:foo (/ *error* p val var)
;; Error function to account for program sh!++ing the bed .. LOCALIZE IT! ^^
(defun *error* (msg)
;; Reset the variables
(mapcar 'setvar var val)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
;; Get variables current settings
(setq var '(cmdecho insunits attreq)
val (mapcar 'getvar var)
)
;; Change them to what you want
(mapcar 'setvar var '(0 0 1))
;; Do your stuff
(setq p (getpoint))
;; Reset the variables
(mapcar 'setvar var val)
)
Sorry, I should have explained more clearly:
Since the suggested ssget expression will return a selection set, you would need to replace:Code: [Select](setq vpent (_selvp (car (nentsel "\nselect viewport"))))
With:Code: [Select](setq vpent (ssname (ssget "_+.:E:S" '((0 . "VIEWPORT"))) 0))
However, note that this does not include error trapping to allow for the user failing to select a Viewport, for which the program will currently error.
Where error trapping is concerned, I would suggest the following for your code:Code: [Select];; Example program written for Swamp thread:
;; http://www.theswamp.org/index.php?topic=45993.0
;; by Lee Mac 2014-01-14
(defun c:tlmk ( / *error* blk dch dcl dwg mark_n sel title_n val var )
(setq dwg "N:/Tuterj/AutoLISP/Working/TitleMark-field.dwg" ;; Block to insert
dcl "N:/tuterj/AutoLISP/Working/TL-MK_Scale_add.dcl" ;; DCL file
)
(defun *error* ( msg )
(mapcar 'setvar var val)
(if (< 0 dch) (unload_dialog dch))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(cond
( (not
(or (tblsearch "block" (setq blk (vl-filename-base dwg)))
(setq blk (findfile dwg))
)
)
(princ (strcat "\n" dwg " file not found."))
)
( (<= (setq dch (load_dialog dcl)) 0)
(princ (strcat "\n" dcl " file not found."))
)
( (not (new_dialog "TLMK" dch))
(princ (strcat "\n" dcl " file contains an error, dialog could not be loaded."))
)
( t
(action_tile "mark_n" "(setq mark_n $value)")
(action_tile "title_n" "(setq title_n $value)")
(action_tile "accept"
(vl-prin1-to-string
'(cond
( (null mark_n)
(alert "Please enter a value for the mark_n tile.")
(mode_tile "mark_n" 2)
)
( (null title_n)
(alert "Please enter a value for the title_n tile.")
(mode_tile "title_n" 2)
)
( (done_dialog 1))
)
)
)
(if (= 1 (start_dialog))
(if (setq sel (LM:ssget "\nSelect viewport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
(progn
(setq var '(cmdecho insunits attreq)
val (mapcar 'getvar var)
)
(mapcar 'setvar var '(0 0 1))
(princ "\nSpecify insertion point for block: ")
(vl-cmdf "_.-insert" blk "_S" 1.0 "_R" 0.0 "\\"
(strcase title_n)
(strcat
"%<\\AcObjProp.16.2 Object(%<\\_ObjId "
(LM:objectid (vlax-ename->vla-object (ssname sel 0)))
">%).CustomScale \\f \"%sn\">%"
)
mark_n
)
(mapcar 'setvar var val)
)
)
(princ "\n*Cancel*")
)
)
)
(if (< 0 dch) (setq dch (unload_dialog dch)))
(princ)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; ObjectID - Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:objectid ( obj )
(eval
(list 'defun 'LM:objectid '( obj )
(if
(and
(wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
(vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:objectid obj)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
Please note that the above code is written in haste & completely untested!
Please refer to this reference (http://bit.ly/137NmOJ) from my site :-)
(setq count 1) ;variable set up for counter to populate mark_n box in dialog box
(while (< count 99)
(setq count (1+ count))
);(while
: edit_box { //Edit box for the Title Mark number.
label = "Mark:";
alignment = left;
key = "mark_n";
fixed_width = true;
edit_limit = 2;
edit_width = 2;
}//:edit_box {
These lines of code do a magnificent job of explaining mapcar....(place glowing light bulb here)
My only question that I've noticed when seeing this use of mapcar is where are the users original settings stored?
As you can see, the original values for each system variable are stored in the list 'val' (for VALues).Code: [Select](setq val (mapcar 'getvar var)) ;set a variable 'val' which holds the values when mapcar applies the "getvar" command to each item in the 'var' list
If the program is modifying attreq to do it's duty, shouldn't attreq be put back to what it's value was before the program was initiated ? j/w, typically heard this is good coding practice and perhaps just a quick and dirty routine was given, still- trying to be clear on the topic!
So let me be clear myself! I'm not asking this to point out any inadequacies in the given code as any code given is a gem and should be respected, ie. not everyone can do it, it's time consuming, and it's very useful for the person intended for. That's a heck of a combination. I did, however, ask because i'm genuinely wondering if there's a mapcar method to save the sys vars beforehand, or is it handled in another fashion when this setup is used.....or...? Thanks! that's why i'm asking.
Here is a simple example to show how the variables are reset in Lee's code:
Lee Mac, Thank you! except for the error trapping the routine is working perfectly. Thank you also for the error trapping suggestions, that is quite a bit for me to study over to make sure I understand what you have written.
Besides the error trapping, my CAD manager has one more thing he wants me to add to the routine. His request was to have the mark number fill in with a sequential number each time the routine is ran
Anyway thank you again for your time and help. I greatly appriciate it. I owe you a couple of pints!