Jump to content

Recommended Posts

Posted

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.

Posted

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)))

Posted

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?

Points.jpg

Posted

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

Posted

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.

Posted

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.

Posted

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

Posted

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 :thumbsup:

 

(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 :)

Posted

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?

Posted

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

Posted

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.

Posted

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.

Posted

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.

Posted

I really hate working with UCS and WCS... a pet peeve of mine I think.. :P

 

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))))

Posted

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."

Posted

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

Posted

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

Posted
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 :thumbsup: good tip!

 

Cheers

 

Lee

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...