Bill Tillman Posted March 21, 2009 Posted March 21, 2009 I copied this cool script from this forum that lets you select a group of points and then it labels and numbers them. I spent time studying how it works and learned so much from it that I decided to expand on it with my own customizations. Most of what I tried worked (surprise, I'm new to LISP) but try as I might I can't seem to get the syntax correct for the math functions I need. The routine grabs a bunch of points and then prints labels for them using decimal format and the X-Y coordinates are printed in inches. I figured out how to convert to Architectural, but the surveyors who use the drawing I'm making will want it all in decimal feet units, not Architectural or even decimal inches. They also wanted the Northing reading first and they will want the Z coordinate as well. So I'm trying to divide all of the coordinates by 12 but I don't seem to understand enough about the syntax to get it right. (defun c:ptlabel (/ mysset counter laylist p1 sch xtxt ytxt) (setq laylist (list "NORTH" "EAST" "NUM")) (foreach x laylist (if (tblsearch "Layer" x) (command "._layer" "_thaw" x "unlock" x "_set" x "") (command "._layer" "_make" x "_color" "7" x "") ) ) (prompt "Select Points: ") (setq mysset (ssget '((0 . "POINT")))) (setq counter 0) (if (null sch) (setq sch 1.0) ) (initget 6) (setq temp (getreal (strcat "\nEnter Scale <" (rtos sch 2 2) ">: "))) (if temp (setq sch temp) (setq temp sch) ) (while (< counter (sslength mysset)) (Setq p1 (cdr (assoc 10 (entget (ssname mysset counter))))) (setq xtxt (strcat "E " (rtos (/ (car p1) 2 4)) 12)) ; [color="Red"]<<- HERE IS THE PROBLEM[/color] (setq ytxt (strcat "N " (rtos (/ (cadr p1) 2 4)) 12)) ; [color="Red"]<<- HERE IS THE PROBLEM[/color] (setq itme (itoa (1+ counter))) ; [color="Red"]Could this be made into one line with the one below...I couldn't get it to work either[/color] (command "text" p1 (* sch 2.5) "0" itme) (command "_change" (entlast) "" "p" "la" "NUM" "c" 40 "") (command "text" "" ytxt) (command "_change" (entlast) "" "p" "la" "NORTH" "c" "g" "") (command "text" "" xtxt) (command "_change" (entlast) "" "p" "la" "EAST" "c" "7" "") (setq counter (+ counter 1)) ) (princ) ) I'm working on adding the "Z" coordinate for more complex projects and think I can handle that. This is a really neat script and I've learned a great deal just working with what few lines it contains. Thanks to the author for posting it. Quote
CarlB Posted March 21, 2009 Posted March 21, 2009 The 'rtos' function convrets a real number to text. So you need to do the math first, then convert the result to text. Instead of: (rtos (/ (car p1) 2 4)) 12)) Use: (rtos (/ (car p1) 12) 2 4))) And to combine those 2 lines: (command "text" p1 (* sch 2.5) "0" (itoa (1+ counter))) Quote
Bill Tillman Posted March 21, 2009 Author Posted March 21, 2009 Thanks Carl. That got me going again after stalling last night. But this morning I tried it on a new and much larger set of points. It worked great but then the surveyor called and said they cannot use the origin point we started with. So I simply moved the UCS to the new origin he wanted. But then when I ran the LISP routine it apparently does not get the complete message about the new UCS orientation and does not plot the labels near the points. Instead it plots them in the same orientation, relative to the new UCS origin which means they are way off base from the point locations. Is there something I'm missing on moving the UCS? Quote
wizman Posted March 21, 2009 Posted March 21, 2009 just a quick question, why is your original ucs not in ucs world?but if youre doing it that way, you need the trans command but if your old ucs is not world, you may need to save your ucs then give it a name so that when the routine runs the routine will be putting it it the correct ucs then put it back again to the new ucs at the end of the routine Quote
Bill Tillman Posted March 21, 2009 Author Posted March 21, 2009 Yes, and I realize that complicates things some. When I originally setup this drawing I took some work done by a landscaping firm and changed the UCS origin to be the corner of one of the buildings on this campus. Then I placed a point at the centerline of each fence post location. I need some more understanding of the UCS. I was under the impression that when I moved it, the p1 variable would simply be set to the location of the existing points. But it appears that the p1 variable is now being set to new locations with the same X-Y distances from the new UCS as it had with the old UCS. Now the surveyor has told me that it's not possible or him to set his instrument up at the location of the old UCS and he has chosen a more workable location. I was hoping that by simply moving the UCS to this new location, everything would fall in line. I have some time today so I'm going to go back and start from scratch using the World UCS to start placing the points. Quote
Bill Tillman Posted March 21, 2009 Author Posted March 21, 2009 I thought I had it but maybe not. Let me see if I can follow this. 1. I can plot a point at 100,100,0 using the WCS in an original drawing freshly created in AutoCAD. 2. I can move the UCS icon to have a new origin of 50,50,0. Of course the new UCS icon will show it's orgin at 0,0,0. 3. If I check the properties of the original point I made it now shows 50,50,0 instead of 100,100,0. 4. I can reset the UCS to WCS and the point will now have properties of 100,100,0 and the UCS icon will be back at the original location and it's origin will again be 0,0,0. This is what I'm after with this LISP routine. I want to be able to establish points using the WCS, then when the surveyor tells me where he will setup his instrument, I want to move the UCS origin there. Then run this LISP routine with it plotting the labels and coordinates at the point locations, showing the X-Y-Z coordinates of the new UCS. What happens is that even though I have moved the UCS icon to a new origin and the points show their new X-Y coordinates based on this new UCS origin, when I run the script, it plots the labels relative distances from the new UCS icon as it did from the original WCS icon. Meaning that the points are there and the labels are there, trouble is the labels are nowhere near the points. Quote
CarlB Posted March 21, 2009 Posted March 21, 2009 The progrm queries the point and obtains its *world* coordintes no matter the UCS. You want UCS cordinate values to be reported, and text placed at UCS coordinates. Which calls for a coordinate transformation. After the line: (Setq p1 (cdr (assoc 10 (entget (ssname mysset counter))))) add this line; (setq p1 (trans p1 0 1));translate from world to UCS Quote
Lee Mac Posted March 21, 2009 Posted March 21, 2009 Also Bill, I would use an entmake method to create the text, instead of the command prompts. TEXT and ATTDEF functions can be pretty dodgy when you use command prompts, depending on the textstyle set. I would consider incorporating a call to this (or something like this) in your routine (defun Make_Text (txt_pt txt_val) (entmake (list '(0 . "TEXT") '(8 . "0") (cons 10 txt_pt) (cons 40 (max 2.5 (getvar "TEXTSIZE"))) (cons 1 txt_val) '(50 . 0.0) '(7 . "STANDARD") '(71 . 0) '(72 . 1) '(73 . 2) (cons 11 txt_pt)))) If you need help incorporating it, just let me know Quote
Bill Tillman Posted March 21, 2009 Author Posted March 21, 2009 Once again, thanks guys for helping me though this. It's working now as it should. Now if it will just stop raining long enough for the surveyors to get back to work on this. And Lee Mac, I'm always up for improvement but being a newbie at LISP I'm not sure how I would add this to the code. Could you elaborate a little more on this? Quote
Lee Mac Posted March 22, 2009 Posted March 22, 2009 I was thinking perhaps this Bill: (defun c:ptlabel (/ *error* ovar vlst ss i temp xtxt ytxt ztxt) (vl-load-com) (defun *error* (msg) (if ovar (mapcar 'setvar vlst ovar)) (princ (strcat "\n<!> Error: " (strcase msg) " <!>")) (princ)) (setq vlst '("CMDECHO" "CLAYER" "OSMODE") ovar (mapcar 'getvar vlst)) (mapcar 'setvar vlst '(0 "0" 0)) (foreach x '("NORTH" "EAST" "NUM" "Z") (if (tblsearch "Layer" x) (command "._layer" "_thaw" x "unlock" x "_set" x "") (command "._layer" "_make" x "_color" "7" x ""))) (prompt "\nSelect Points: ") (if (setq ss (ssget '((0 . "POINT")))) (progn (setq i 1) (or sch (setq sch 1.0)) (initget 6) (setq temp (getreal (strcat "\nEnter Scale <" (rtos sch 2 2) ">: "))) (or (not temp) (setq sch temp)) (foreach pt (mapcar '(lambda (x) (trans (cdr (assoc 10 (entget x))) 0 1)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (setq xtxt (strcat "E " (rtos (/ (car pt) 12) 2 4)) ytxt (strcat "N " (rtos (/ (cadr pt) 12) 2 4)) ztxt (strcat "Z " (rtos (/ (caddr pt) 12) 2 4))) (Make_Text pt (rtos i 2 0) 40 "NUM") (Make_Text (polar pt (/ (* 3 pi) 2) (* sch 3.0)) ytxt 3 "NORTH") (Make_Text (polar pt (/ (* 3 pi) 2) (* sch 6.0)) xtxt 7 "EAST") (Make_Text (polar pt (/ (* 3 pi) 2) (* sch 9.0)) ztxt 1 "Z") (setq i (1+ i)))) (princ "\n<!> No Points Selected <!>")) (mapcar 'setvar vlst ovar) (princ)) (defun Make_Text (pt val col lay) (entmake (list '(0 . "TEXT") (cons 8 lay) (cons 10 pt) (cons 40 (* sch 2.5)) (cons 1 val) '(50 . 0.0) (cons 7 (getvar "TEXTSTYLE")) (cons 62 col) '(71 . 0) '(72 . 1) '(73 . 2) (cons 11 pt)))) I have heavily modified your code, (hopefully for the better!), if you want me to explain anything I have done, just ask Cheers Lee Quote
Bill Tillman Posted March 22, 2009 Author Posted March 22, 2009 Dude, that is awesome. The other script was great but with the drawing I was using which had only 80 points in it, there would be a noticeable delay between the time I pressed enter and the time it finished. This script finished faster than I could pull my finger off the enter key. I will study this one in depth. The only thing I see is that the trans function is not working because when I moved the UCS I got the same trouble as before, the labels printed off somewhere besides the points unless I set the WCS. The real trick with what I'm trying to do is to down and dirty be able to give the surveyors accurate point data no matter where they setup. And with this job, the surveyors keep changing their minds on where they want to setup. I can't blame them as this site has lots of existing structures and obstacles to deal with. Thanks again and I'm really learning alot from you guys. Quote
CarlB Posted March 22, 2009 Posted March 22, 2009 Lee's routine uses 'entmake' to place the text, the text is placed at World coordinates. (the previous method used the (command "text" etc...) which places text at UCS coordinates. So 'trans should not be used on the coordinates for the 'entmake' text placement. For determining the x/y values, the coordinates do need to be transformed. Quote
Bill Tillman Posted March 22, 2009 Author Posted March 22, 2009 If I'm not mistaken, line #27 of Lee's code does use the trans function: (foreach pt (mapcar '(lambda (x) (trans (cdr (assoc 10 (entget x))) 0 1)) But this program will only plot the labels at the WCS coordinates. I'm hacking at this again this morning to get it working like the other which will plot to whatever the current UCS is at. Any advice would be appreciated. Quote
Lee Mac Posted March 22, 2009 Posted March 22, 2009 I really hate working with UCS and WCS... a pet peeve of mine I think.. But going on Carl's knowledge of such things, would this suffice? (defun c:ptlabel (/ *error* ovar vlst ss i temp UCSpt xtxt ytxt ztxt) (vl-load-com) (defun *error* (msg) (if ovar (mapcar 'setvar vlst ovar)) (princ (strcat "\n<!> Error: " (strcase msg) " <!>")) (princ)) (setq vlst '("CMDECHO" "CLAYER" "OSMODE") ovar (mapcar 'getvar vlst)) (mapcar 'setvar vlst '(0 "0" 0)) (foreach x '("NORTH" "EAST" "NUM" "Z") (if (tblsearch "Layer" x) (command "._layer" "_thaw" x "unlock" x "_set" x "") (command "._layer" "_make" x "_color" "7" x ""))) (prompt "\nSelect Points: ") (if (setq ss (ssget '((0 . "POINT")))) (progn (setq i 1) (or sch (setq sch 1.0)) (initget 6) (setq temp (getreal (strcat "\nEnter Scale <" (rtos sch 2 2) ">: "))) (or (not temp) (setq sch temp)) (foreach pt (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (setq UCSpt (trans pt 0 1) xtxt (strcat "E " (rtos (/ (car UCSpt) 12) 2 4)) ytxt (strcat "N " (rtos (/ (cadr UCSpt) 12) 2 4)) ztxt (strcat "Z " (rtos (/ (caddr UCSpt) 12) 2 4))) (Make_Text pt (rtos i 2 0) 40 "NUM") (Make_Text (polar pt (/ (* 3 pi) 2) (* sch 3.0)) ytxt 3 "NORTH") (Make_Text (polar pt (/ (* 3 pi) 2) (* sch 6.0)) xtxt 7 "EAST") (Make_Text (polar pt (/ (* 3 pi) 2) (* sch 9.0)) ztxt 1 "Z") (setq i (1+ i)))) (princ "\n<!> No Points Selected <!>")) (mapcar 'setvar vlst ovar) (princ)) (defun Make_Text (pt val col lay) (entmake (list '(0 . "TEXT") (cons 8 lay) (cons 10 pt) (cons 40 (* sch 2.5)) (cons 1 val) '(50 . 0.0) (cons 7 (getvar "TEXTSTYLE")) (cons 62 col) '(71 . 0) '(72 . 1) '(73 . 2) (cons 11 pt)))) Quote
Bill Tillman Posted March 22, 2009 Author Posted March 22, 2009 In my previous years of working as an IT manager I would often do simple things to resolve major problems for various companies. It doesn't happen anymore, but back in the late 1990's when computers were still a difficult thing for most users, I was amazed to be treated like royalty and an intellect simply because I knew what to do when a system or network went down. Many times I would leave the offices of my clients with them bowing their heads and chanting "Thank you oh great computer guru" in praise of me saving their jobs. So in that same humble manner, this my way of bowing my head to you guys and your superior intellect and chanting, "Thank you oh great AutoLisp gurus." Quote
Lee Mac Posted March 22, 2009 Posted March 22, 2009 Many thanks Bill for your kind words - they are much appreciated. With more experience, I'm sure you could accomplish the same things, and as I have mentioned earlier, if you need any more clarification on any aspect of the routine I posted, just ask Cheers Lee Quote
David Bethel Posted March 22, 2009 Posted March 22, 2009 Lee, By using entmake, there is no real need to setup the LAYER table. entmake will create a LAYER if it isn't present and will sucessfully make the entity regardless of the layer state. Maybe Bill has a absolute need for TEXT, but I think an ATTRIButed INSERT would have made life a lot easier. -David Quote
Lee Mac Posted March 22, 2009 Posted March 22, 2009 Lee, By using entmake, there is no real need to setup the LAYER table. entmake will create a LAYER if it isn't present and will sucessfully make the entity regardless of the layer state. Maybe Bill has a absolute need for TEXT, but I think an ATTRIButed INSERT would have made life a lot easier. -David Thanks David, I didn't actually know that entmake would automatically create the necessary layers good tip! Cheers Lee 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.