Darryl Posted September 10, 2018 Posted September 10, 2018 (edited) Hello. I am not a lisp guy by any stretch, I've always made my way by finding various lisp routines and blending them together to get my desired result, but I'm completely at a loss for this one. What I need is a lisp routine that will lox the x and y coordinated of a click point, offer a second click to drop a block with a number value and both x and y results, with a leader arrow to the initial click point. As usual, I found a few lisp routines (lee mac is pretty much a genius) that did portions of the work, but I can't for the life of me figure out how to connect them. The Code below will result in a leader with the X and Y shown, but I need to get this information into a block, and that block must contain a sequence number. (defun c:COOR ( / i l s x ) ;; Define function, declare local variable symbols. ;; To understand why variable declaration is important, see http://bit.ly/15Qw104 (setq PNT1 (getpoint "\nPick coordinate point: ")) (setq P1X (car pnt1)) ;x coord (setq P1Y (cadr pnt1)) ;y coord (setq STDX (rtos P1X 2 2)) (setq STDY (rtos P1Y 2 2)) (setq COORDN (strcat "Y " STDY )) (setq COORDE (strcat "X " STDX )) (if ;; If we can retrieve a set of attributed blocks (setq s ;; Assign the selection set pointer to variable 's' (ssget "_X" ;; Search entire database (see http://bit.ly/137NmOJ for more info) '( (0 . "INSERT") ;; Block References (66 . 1) ;; Attributed (2 . "coordinate") ;; with name coordinate (this assumes block is non-dynamic) ) ) ;; end SSGET ) ;; end SETQ (progn ;; Evaluate the following expressions and return the result ;; of the last expression evaluated. PROGN is used as a ;; wrapper function so that we can pass multiple expressions ;; to the IF function as a single argument constituting the ;; 'then' parameter. (initget 6) ;; (+ 2 4): 2=prevent zero, 4=prevent negative (if (setq x (getreal "\nEnter first SEQUENCE number: ")) ;; Prompt user for rung number > 0 (progn ;; See above explanation for PROGN ;; Construct an association list of attribute tags & values ;; to pass to the LM:setattributevalues function (setq l (cons (cons "SEQUENCE" (itoa (fix x))) ;; => e.g. ("SEQUENCE" . "2") ;; Use a quoted literal list for the remaining tags/values ;; as there are no expressions to be evaluated. ;; For an explanation of the apostrophe, see http://bit.ly/1bW3rQK '( ("X" . "20") ("Y" . "1") ) ) ;; end CONS ) ;; end SETQ ;; The resulting list might look like this: ;; l = (("SEQUENCE" . "2") ("X" . "20") ("Y" . "1")) ;; Repeat the following expressions a number of times ;; equal to the number of items in the selection set. ;; Note that the numerical argument for the repeat function ;; is only evaluated once and hence the integer index variable 'i' ;; will only be assigned a value once. (repeat (setq i (sslength s)) ;; Call the LM:setattributevalues function with the block entity name ;; and association list of attribute tags/values to be set. (LM:SetAttributeValues (ssname s (setq i (1- i))) l) ) ;; end REPEAT ) ;; end PROGN ) ;; end IF ) ;; end PROGN ;; Else no blocks were found... (princ "\nNo \"COORDINATE\" blocks were found.") ) ;; end IF (princ) ;; Supress the return of the last evaluated expression ) ;; end DEFUN ;; Set Attribute Values - Lee Mac ;; Sets the block attributes whose tags are found in the supplied ;; assocation list to their associated values. ;; Arguments: ;; blk - [ent] Block (Insert) Entity Name ;; lst - [lst] Association list of ((<TAG> . <Value>) ... ) ;; Returns: nil (defun LM:SetAttributeValues ( blk lst / enx itm ) (if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk))))))) (if (setq itm (assoc (strcase (cdr (assoc 2 enx))) lst)) (progn (if (entmod (subst (cons 1 (cdr itm)) (assoc 1 enx) enx)) (entupd blk) ) (LM:SetAttributeValues blk lst) ) (LM:SetAttributeValues blk lst) ) ) ) (princ) ;; Suppress the return of any loading expressions I suppose at worst case I can go through the job and manually enter the sequence number. Basically, the general contractor is insisting that I supply coordinates for all concrete embedments, hundreds of them, and I want to use Autocads export options to generate a list of all coordinate blocks; manual export poses the risk of erroneous entry, and potential future revisions can run the same risk .. With blocks and exports, we can generare a new list with every plot. Can anyone help me out here? Thanks. Edited September 10, 2018 by CADTutor Added code to block Quote
dlanorh Posted September 10, 2018 Posted September 10, 2018 You need to do two things, design and make a block with 3 attributes that correspond to Sequence No, Easting and Northing. Then make a MLeader style where the content is a block, Not MText. (See attached drawing as a guide). MLeader Style "standard" has been modified so that the content is a block. Inserting a mleader in this style automatically inserts a block as content. Its pretty simple to then get the arrow point coords as you insert the mleader and update the block attributes. leaderandblock.dwg Quote
Darryl Posted September 11, 2018 Author Posted September 11, 2018 Making the block is easy, what I don't understand is how to interrupt the insert command so the attribute prompts don't pop up, or how to automatically populate those values. Like I said, not strong on lisp. Quote
Darryl Posted September 11, 2018 Author Posted September 11, 2018 Ok, so I've got something cooking here.. (defun C:CT(/ PNT1 P1X P1Y STDY DY COORDN COORDE PTXT) (setvar "attreq" 1) (setvar "attdia" 0) (setq PNT1 (getpoint "\nPick coordinate point: ")) (setq P1X (car pnt1)) ;x coord (setq P1Y (cadr pnt1)) ;y coord (setq STDX (rtos P1X 2 2)) (setq STDY (rtos P1Y 2 2)) (setq COORDN (strcat "X " STDY )) (setq COORDE (strcat "Y " STDX )) (setq PTXT (getpoint "\nPick text location: ")) (command "mLEADER" PNT1 PTXT 01 coordn coorde) (princ) ) Thanks to dlanorh for the tip with the leader block, I didn't think of that and it was definitely the easier route. This code now does exactly what I need in terms of X and Y coordinates. I will openly admit I just messed around with another lisp I had found that defined the X and Y, I'm terrible with code. The next step is trying to get the first attribute 01 between PTXT and coordn to increase by one with every click... Quote
dlanorh Posted September 11, 2018 Posted September 11, 2018 (edited) I think you need to look at your (setq COORDN ) and (setq COORDE), something is not right with the labelling As for incrementing, consider (setq inc_no 1) ... ... (while (setq PNT1 (getpoint "\nPick coordinate point: ")) .... .... (setq inc_str (itoa inc_no)) (command "mleader" pnt1 ptxt inc_str coordn coorde) (setq inc_no (1+ inc_no)) );end_while This will loop away inserting leaders until you may a null entry (press enter or right click mouse). Each time it loops through it will add 1 to inc_no then convert it to a string for inserting. Edited September 11, 2018 by dlanorh Quote
Darryl Posted September 11, 2018 Author Posted September 11, 2018 Could you elaborate at all? The lisp I provided does in fact produce the desired result of filling the x and y via the coordn and coorde, I'm not sure what might be mislabled as I build by dissassembling and reassembling lisps I find along the way. Thakns for the input on the cycle, it works perfectly. (defun C:CT(/ PNT1 P1X P1Y STDY DY COORDN COORDE PTXT) (setq inc_no 1) (setvar "attreq" 1) (setvar "attdia" 0) (while (setq PNT1 (getpoint "\nPick coordinate point: ")) (setq P1X (car pnt1)) ;x coord (setq P1Y (cadr pnt1)) ;y coord (setq STDX (rtos P1X 2 2)) (setq STDY (rtos P1Y 2 2)) (setq COORDN (strcat "X " STDY )) (setq COORDE (strcat "Y " STDX )) (setq PTXT (getpoint "\nPick text location: ")) (setq inc_str (itoa inc_no)) (command "mleader" pnt1 ptxt inc_str coordn coorde) (setq inc_no (1+ inc_no)) );end_while (princ) ) Heres a question, is there a way to have it look for the previous block number, or prompt the user the enter a starting point for only the first leader? Right now if I stop for any reason it restarts at 1. Quote
Darryl Posted September 11, 2018 Author Posted September 11, 2018 Bingo (defun C:CT(/ PNT1 P1X P1Y STDY DY COORDN COORDE PTXT) (setq inc_no (getint "\nTAG1 value: ")) (setvar "attreq" 1) (setvar "attdia" 0) (while (setq PNT1 (getpoint "\nPick coordinate point: ")) (setq P1X (car pnt1)) ;x coord (setq P1Y (cadr pnt1)) ;y coord (setq STDX (rtos P1X 2 2)) (setq STDY (rtos P1Y 2 2)) (setq COORDN (strcat "X " STDY )) (setq COORDE (strcat "Y " STDX )) (setq PTXT (getpoint "\nPick text location: ")) (setq inc_str (itoa inc_no)) (command "mleader" pnt1 ptxt inc_str coordn coorde) (setq inc_no (1+ inc_no)) );end_while (princ) ) If you can think of a way to improve this I am all ears, but this works provided the user verifies the last number used to ensure proper continuation. Quote
dlanorh Posted September 11, 2018 Posted September 11, 2018 (edited) 49 minutes ago, Darryl said: Could you elaborate at all? The lisp I provided does in fact produce the desired result of filling the x and y via the coordn and coorde, I'm not sure what might be mislabled as I build by dissassembling and reassembling lisps I find along the way. Thakns for the input on the cycle, it works perfectly. (defun C:CT(/ PNT1 P1X P1Y STDY DY COORDN COORDE PTXT) (setq inc_no 1) (setvar "attreq" 1) (setvar "attdia" 0) (while (setq PNT1 (getpoint "\nPick coordinate point: ")) (setq P1X (car pnt1)) ;x coord (setq P1Y (cadr pnt1)) ;y coord (setq STDX (rtos P1X 2 2)) (setq STDY (rtos P1Y 2 2)) (setq COORDN (strcat "X " STDY )) (setq COORDE (strcat "Y " STDX )) (setq PTXT (getpoint "\nPick text location: ")) (setq inc_str (itoa inc_no)) (command "mleader" pnt1 ptxt inc_str coordn coorde) (setq inc_no (1+ inc_no)) );end_while (princ) ) Heres a question, is there a way to have it look for the previous block number, or prompt the user the enter a starting point for only the first leader? Right now if I stop for any reason it restarts at 1. OK (setq COORDN (strcat "X " STDY )) This is the Northing Coordinate (Y axis) yet you are labelling it "X".Vice Versa for the Easting coordinate. This could lead to confusion. Coordinates are an Easting, a Northing and when required a level, so Label them "E " and "N " As to improving the code, 1. It is good practice to to reset any changed system variables to the lisp entry state. 2. Declare all variables used in the routine as local unless you really mean them to be global. This is important. Global variables can be read by any other lisps running in the current session and can have unforseen consequences. The variables inc_no and inc_str were missing and you had STDY DY in your local variables when it should have been STDY STDX So : (defun C:CT ( / inc_no attr attd PNT1 P1X P1Y STDX STDY COORDE COORDN PTXT inc_str) ..... (setq attr (getvar "attreq") attd (getvar "attdia") ) (setvar "attreq" 1) (setvar "attdia" 0) ... ... ;then at the end );end while (setvar "attreq" attr) (setvar "attdia" attd) (princ) ) Edited September 11, 2018 by dlanorh Quote
dlanorh Posted September 11, 2018 Posted September 11, 2018 I forget to mention that you can group setq's together like so (setq a 1 b 2 c 3 d 4 );end setq Quote
Darryl Posted September 11, 2018 Author Posted September 11, 2018 Thanks so much! I'm going to try the grouping tomorrow, but for now, I have included your other notes and it runs perfectly. Thanks for catching the inverted coordinates, I had not done a proper dry run and completely missed it. Quote
dlanorh Posted September 11, 2018 Posted September 11, 2018 30 minutes ago, Darryl said: Thanks so much! I'm going to try the grouping tomorrow, but for now, I have included your other notes and it runs perfectly. Thanks for catching the inverted coordinates, I had not done a proper dry run and completely missed it. No problem. Glad i could help. Quote
maratovich Posted September 12, 2018 Posted September 12, 2018 Darryl Do you work in a model or in layouts? Quote
BIGAL Posted September 12, 2018 Posted September 12, 2018 Getting last number is pretty easy, if you use a block attribute you just do a search all the one block name attributes and just get the last value display this as do you want to start with this number or another. Something real old that I have (defun c:setlpno (/ att el1 en en1 index n ss1) (setvar "cmdecho" 0) (setq temperr *error*) (setq *error* trap) (command "undo" "m") (setq ss1 (ssget "x" '((2 . "setout_point")))) ; your blockname (setq pno 0) (setq n (sslength ss1)) (setq index 0) (repeat n (setq en (ssname ss1 index)) (setq index (+ index 1)) (setq en1 (entnext en)) (setq el1 (entget en1)) (setq att (atoi (cdr (assoc 1 el1)))) (if (> att pno) (setq pno att)) );repeat (setq pno (+ pno 1)) (prompt "Next Setout Point No.< ")(prin1 pno)(prompt ">: ") (setq *error* temperr) (princ) ) Quote
Darryl Posted September 12, 2018 Author Posted September 12, 2018 1 hour ago, maratovich said: Darryl Do you work in a model or in layouts? Model only Quote
Darryl Posted September 12, 2018 Author Posted September 12, 2018 1 hour ago, BIGAL said: Getting last number is pretty easy, if you use a block attribute you just do a search all the one block name attributes and just get the last value display this as do you want to start with this number or another. Something real old that I have (defun c:setlpno (/ att el1 en en1 index n ss1) (setvar "cmdecho" 0) (setq temperr *error*) (setq *error* trap) (command "undo" "m") (setq ss1 (ssget "x" '((2 . "setout_point")))) ; your blockname (setq pno 0) (setq n (sslength ss1)) (setq index 0) (repeat n (setq en (ssname ss1 index)) (setq index (+ index 1)) (setq en1 (entnext en)) (setq el1 (entget en1)) (setq att (atoi (cdr (assoc 1 el1)))) (if (> att pno) (setq pno att)) );repeat (setq pno (+ pno 1)) (prompt "Next Setout Point No.< ")(prin1 pno)(prompt ">: ") (setq *error* temperr) (princ) ) Thanks so much, I’m going to try this when I get back from Vegas. I’ll have a few questions on how it works as well. Quote
dlanorh Posted September 12, 2018 Posted September 12, 2018 4 hours ago, BIGAL said: Getting last number is pretty easy, if you use a block attribute you just do a search all the one block name attributes and just get the last value display this as do you want to start with this number or another. Something real old that I have (defun c:setlpno (/ att el1 en en1 index n ss1) (setvar "cmdecho" 0) (setq temperr *error*) (setq *error* trap) (command "undo" "m") (setq ss1 (ssget "x" '((2 . "setout_point")))) ; your blockname (setq pno 0) (setq n (sslength ss1)) (setq index 0) (repeat n (setq en (ssname ss1 index)) (setq index (+ index 1)) (setq en1 (entnext en)) (setq el1 (entget en1)) (setq att (atoi (cdr (assoc 1 el1)))) (if (> att pno) (setq pno att)) );repeat (setq pno (+ pno 1)) (prompt "Next Setout Point No.< ")(prin1 pno)(prompt ">: ") (setq *error* temperr) (princ) ) I don't think you can do this with blocks attached to MLeaders, and AFAICT you can only access the Blocks Definition though the MLeader methods. It is possibe however if you explode the MLeader after inserting it. Quote
Jef! Posted September 12, 2018 Posted September 12, 2018 (edited) 7 hours ago, dlanorh said: I don't think you can do this with blocks attached to MLeaders, and AFAICT you can only access the Blocks Definition though the MLeader methods. It is possibe however if you explode the MLeader after inserting it. You could also dig through the dict... Here, LSName being the mleader style name and tag being the tag we seek for... (defun c:tst ( / LSName tag mldict mlstyle maxval mlsdef interrupt subent mlssubents found tmp vlobj) (setq LSName "Standard") (setq tag "SEQ_NO") (setq mldict (cdr (assoc 350 (member '(3 . "ACAD_MLEADERSTYLE") (entget(namedobjdict)))))) (setq mlstyle (cdr (assoc 350 (member (cons 3 LSName) (entget mldict))))) (setq maxval 0) (if (setq mlsDef (entget mlstyle)) (foreach subent (setq mlsSubents (massoc 330 mlsDef)) (if (and (= (vla-get-objectname (vlax-ename->vla-object subent)) "AcDbMLeader") (setq tmp (massoc 330 (entget subent))) ) (foreach x tmp (if (and (= (vla-get-objectname (setq vlobj (vlax-ename->vla-object x))) "AcDbAttributeDefinition") (= (vla-get-TagString vlobj) tag) ) (progn (setq found (cdr(assoc 302 (member (cons 330 x) (entget subent))))) ;(alert found) (if (vl-every '(lambda (x) (< 47 x 58)) (vl-string->list found )) (setq maxval (max maxval (atoi found))) ) ) ) ) ) ) ) (if (not found) (princ (strcat "\n"tag " not found in " LSName" MLStyle")) ) (alert (strcat "Next leader should have a seq_no of " (itoa(1+ maxval)))) (1+ maxval) ) (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) ) ) (reverse nlist) ) the vl-every make sure only numbers are taken in consideration. I take the max value found, and increment by 1 to determine the next one. Cheers. Edited September 12, 2018 by Jef! removed html highlighting... added massoc function 1 Quote
BIGAL Posted September 13, 2018 Posted September 13, 2018 Nice one Jef, the code I posted has a simple block with circle and attribute and uses a radial line back to the point, very simple its probably 20 year old code. Quote
dlanorh Posted September 13, 2018 Posted September 13, 2018 9 hours ago, Jef! said: You could also dig through the dict... Here, LSName being the mleader style name and tag being the tag we seek for... (defun c:tst ( / LSName tag mldict mlstyle maxval mlsdef interrupt subent mlssubents found tmp vlobj) (setq LSName "Standard") (setq tag "SEQ_NO") (setq mldict (cdr (assoc 350 (member '(3 . "ACAD_MLEADERSTYLE") (entget(namedobjdict)))))) (setq mlstyle (cdr (assoc 350 (member (cons 3 LSName) (entget mldict))))) (setq maxval 0) (if (setq mlsDef (entget mlstyle)) (foreach subent (setq mlsSubents (massoc 330 mlsDef)) (if (and (= (vla-get-objectname (vlax-ename->vla-object subent)) "AcDbMLeader") (setq tmp (massoc 330 (entget subent))) ) (foreach x tmp (if (and (= (vla-get-objectname (setq vlobj (vlax-ename->vla-object x))) "AcDbAttributeDefinition") (= (vla-get-TagString vlobj) tag) ) (progn (setq found (cdr(assoc 302 (member (cons 330 x) (entget subent))))) ;(alert found) (if (vl-every '(lambda (x) (< 47 x 58)) (vl-string->list found )) (setq maxval (max maxval (atoi found))) ) ) ) ) ) ) ) (if (not found) (princ (strcat "\n"tag " not found in " LSName" MLStyle")) ) (alert (strcat "Next leader should have a seq_no of " (itoa(1+ maxval)))) (1+ maxval) ) (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) ) ) (reverse nlist) ) the vl-every make sure only numbers are taken in consideration. I take the max value found, and increment by 1 to determine the next one. Cheers. Sweet! I'm adding this to my mleader function collection. Quote
Jef! Posted September 14, 2018 Posted September 14, 2018 On 9/12/2018 at 10:52 PM, BIGAL said: Nice one Jef, the code I posted has a simple block with circle and attribute and uses a radial line back to the point, very simple its probably 20 year old code. Thanks Bigal. MLeaders are an adesk classical case new stuff material, made of old things, but in a way that you cannot interact with the old things like you do with the said old things. You have to dig.. and dig... and dig. When you think you are there, dig deeper. You get there, eventually,. using a reinvented wheel On 9/13/2018 at 1:41 AM, dlanorh said: Sweet! I'm adding this to my mleader function collection. Glad you found it useful! Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.