Jump to content

Labeling Circle with ssget

robert61303

By robert61303
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

robert61303 Newbie

robert61303

Posted
Posted

Hi,

 

I have a lisp to label all the circle in once with the coordinate save in the text file. The lisp and the dwg is as below. My question is how to put circles in different groups with prefix. After looking up ssget function for selecting circle, I haven't find a great way to choose. Four method was found in the web and is putted in the code. The first method is using select-method "w" is working, but the window isn't that flexible to choose the one I want. The second method stop after selecting the circle. The third method comes up with the "error: bad argument type: lselsetp nil". The forth method has the same result as the third method. I thinking of using the WPolygon selecting method, but don't know how to write it.

 

By the way, how to export the entity name to the text file? The variable that contain the entity name isn't a string, so I don't know how to put it in the text file.

 

Drawing2.dwg

 

(defun c:labelcircle()
 (command "CMDECHO" "0")
 (command "layer" "m" "hk" "c" "1" "" "")
 (setq yy (entsel"\nselect the circle :"))
 (setq sews (getstring "\ninput the prefix："))
 (setq f (open (getfiled "text file save as" "c:" "txt" 1) "w"))
 (setq y (entget (car yy)))
 (setq tc (assoc 8 y))
 (setq dx (assoc 40 y))
 (setq zg (cdr dx))
 ;-----1st method
 ;(setq p1 (getpoint "\nFirst Corner: "))
 ;(setq p2 (getcorner p1 "\nSecond Corner: "))
 ;(setq s (ssget "w" p1 p2 (list '(0 . "CIRCLE") tc dx)))
 ;-----2nd method
 ;(command "select" "WP")
 ;(setq s (ssget "_P"))
 ;-----3rd method
 ;(setq ptlst '())
 ;(setq pts 1)
 ;(while pts
 ;  (setq pts(getpoint "\nSelect Point: "))
 ;  (if pts (setq ptlst (cons pts ptlst)))
 ;_while
 ;(if pts 
 ;  (setq s(ssget "_WP" ptlst))
 
 ;-----4th method
 ;(while (setq pt (getpoint pt "\nSpecify a point:"))
 ;  (setq ptlst (cons pt ptlst))
 ;while
 ;(if ptlst
 ;  (setq s (ssget "_WP" ptlst))
 ;if
 ;-----
 (setq n 0)
 (setq m (- (sslength s) 1))
   (while
   (setq a (ssname s m))
   (setq xy (cdr (assoc 10 (entget a))))
   (setq xy1 (polar xy (/ pi 4) )
   (setq dh (rtos (+ 1 n) 2 0)) 
   (command "layer" "s" "hk" "")
   (command "text" "j" "m" xy1 3 "0" (strcat sews dh))
   (setq ss (strcat sews dh "," (rtos (nth 0 xy) 2 3) "," (rtos (nth 1 xy) 2 3) ","))
   (write-line ss f)
   (setq n (1+ n))
   (setq m (1- m))
  );while
);defun

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

3rd method remove ;(setq pts 1)

 

suggestion

(repeat (setq m (sslength s))
   (setq a (ssname s (setq m (- m 1))))
   (setq xy (cdr (assoc 10 (entget a))))
   (setq xy1 (polar xy (/ pi 4) )
   (setq dh (rtos (+ 1 n) 2 0)) 
   (command "layer" "s" "hk" "")
   (command "text" "j" "m" xy1 3 "0" (strcat sews dh))
   (setq ss (strcat sews dh "," (rtos (nth 0 xy) 2 3) "," (rtos (nth 1 xy) 2 3) ","))
   (write-line ss f)
  ); repeat

Link to comment
Share on other sites
robert61303 Newbie

robert61303

Posted
  • Author
Posted

I tried the third method and remove ";(setq pts 1)", but the result is ""error: bad argument type: lselsetp nil". What's wrong with the code? Is there anything to do with my version AutoCAD 2010?

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted

I'm not sure did I fully understood your request, but I've done some practice today:

[b][color=BLACK]([/color][/b]defun C:test [b][color=FUCHSIA]([/color][/b] / osm *error* p ptL #FilePath SS pref #File i e enx a[b][color=FUCHSIA])[/color][/b]
[color=#8b4513]; Lee Mac helped,[/color]
[color=#8b4513]; Tharwat helped,[/color]
[color=#8b4513]; Roy_043 helped,[/color]
[color=#8b4513]; written by Grrr[/color]
[b][color=FUCHSIA]([/color][/b]setq osm [b][color=NAVY]([/color][/b]getvar 'osmode[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

[b][color=FUCHSIA]([/color][/b]defun *error* [b][color=NAVY]([/color][/b] msg [b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]redraw[b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if osm [b][color=MAROON]([/color][/b]setvar 'osmode osm[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if #File [b][color=MAROON]([/color][/b]close #File[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if 
		[b][color=MAROON]([/color][/b]or 
			[b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]member msg '[b][color=RED]([/color][/b][color=#2f4f4f]"Function cancelled"[/color] [color=#2f4f4f]"quit / exit abort"[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]wcmatch [b][color=BLUE]([/color][/b]strcase msg[b][color=BLUE])[/color][/b] [color=#2f4f4f]"*BREAK,*CANCEL*,*EXIT*"[/color][b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]princ [b][color=GREEN]([/color][/b]strcat [color=#2f4f4f]"\nError: "[/color] msg[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]princ[b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b][color=#8b4513]; defun[/color]

[b][color=FUCHSIA]([/color][/b]redraw[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setvar 'errno 0[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]/= 52 [b][color=MAROON]([/color][/b]getvar 'errno[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [color=#8b4513]; collect the pointlist[/color]
	[b][color=NAVY]([/color][/b]initget 128 [color=#2f4f4f]"D DONE"[/color][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]setq p [b][color=MAROON]([/color][/b]getpoint [color=#2f4f4f]"\nSpecify point or [D]one: "[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]cond
		[b][color=MAROON]([/color][/b] [color=#8b4513]; store p in lst, and grvecs[/color]
			[b][color=GREEN]([/color][/b]listp p[b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq ptL [b][color=BLUE]([/color][/b]cons p ptL[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]redraw[b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]if [b][color=BLUE]([/color][/b]>= [b][color=RED]([/color][/b]length ptL[b][color=RED])[/color][/b] 2[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]grvecs [b][color=RED]([/color][/b]cons -3 [b][color=PURPLE]([/color][/b]apply 'append [b][color=TEAL]([/color][/b]mapcar 'list ptL [b][color=OLIVE]([/color][/b]cons [b][color=GRAY]([/color][/b]last ptL [b][color=GRAY])[/color][/b] ptL[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][color=#8b4513]; <- CHECK this[/color]
		[b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b] [color=#8b4513]; attempt to finish without more than 2 points[/color]
			[b][color=GREEN]([/color][/b]and 
				[b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]listp p[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 
				[b][color=BLUE]([/color][/b]wcmatch [b][color=RED]([/color][/b]strcase p[b][color=RED])[/color][/b] [color=#2f4f4f]"D,DONE"[/color][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]<= [b][color=RED]([/color][/b]length ptL[b][color=RED])[/color][/b] 2[b][color=BLUE])[/color][/b][color=#8b4513]; <- CHECK this[/color]
			[b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]princ [color=#2f4f4f]"\nYou are not done, specify atleast 3 points! "[/color][b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b] [color=#8b4513]; attempt to finish with more than 2 points[/color]
			[b][color=GREEN]([/color][/b]and 
				[b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]listp p[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 
				[b][color=BLUE]([/color][/b]wcmatch [b][color=RED]([/color][/b]strcase p[b][color=RED])[/color][/b] [color=#2f4f4f]"D,DONE"[/color][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]> [b][color=RED]([/color][/b]length ptL[b][color=RED])[/color][/b] 2[b][color=BLUE])[/color][/b][color=#8b4513]; <- CHECK this[/color]
			[b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setvar 'errno 52[b][color=GREEN])[/color][/b] [color=#8b4513]; exit loop[/color]
			[b][color=GREEN]([/color][/b]setq ptL [b][color=BLUE]([/color][/b]reverse ptL[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]listp p[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [color=#8b4513]; user pressed enter[/color]
			[b][color=GREEN]([/color][/b]setvar 'errno 52[b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq ptL nil[b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]princ [color=#2f4f4f]"\nUser pressed enter, exiting! "[/color][b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]T
			nil
		[b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b][color=#8b4513]; cond[/color]
[b][color=FUCHSIA])[/color][/b][color=#8b4513]; while[/color]

[b][color=FUCHSIA]([/color][/b]setvar 'osmode 0[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]if 
	[b][color=NAVY]([/color][/b]and
		ptL
		[b][color=MAROON]([/color][/b]or [color=#8b4513]; either open existing file, either create new file:[/color]
			[b][color=GREEN]([/color][/b]setq #FilePath [b][color=BLUE]([/color][/b]getfiled [color=#2f4f4f]"Open Existing txt File"[/color] [color=#2f4f4f]""[/color] [color=#2f4f4f]"txt"[/color] 0[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq #FilePath [b][color=BLUE]([/color][/b]getfiled [color=#2f4f4f]"Create New txt File"[/color] [color=#2f4f4f]""[/color] [color=#2f4f4f]"txt"[/color] 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]setq pref [b][color=GREEN]([/color][/b]getstring [color=#2f4f4f]"\nSpecify prefix: "[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]progn
		[b][color=MAROON]([/color][/b]redraw[b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]vla-ZoomExtents [b][color=GREEN]([/color][/b]vlax-get-acad-object[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]setq SS [b][color=GREEN]([/color][/b]ssget [color=#2f4f4f]"_WP"[/color] ptL [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 0 [color=#2f4f4f]"CIRCLE"[/color][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cons 410 [b][color=PURPLE]([/color][/b]getvar 'ctab[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [color=#8b4513]; <- CHECK this[/color]
		
		[b][color=MAROON]([/color][/b]setq #File [b][color=GREEN]([/color][/b]open #FilePath [color=#2f4f4f]"w"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]repeat [b][color=GREEN]([/color][/b]setq i [b][color=BLUE]([/color][/b]sslength SS[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq e [b][color=BLUE]([/color][/b]ssname SS [b][color=RED]([/color][/b]setq i [b][color=PURPLE]([/color][/b]1- i[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq enx [b][color=BLUE]([/color][/b]entget e[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]write-line 
				[b][color=BLUE]([/color][/b]strcat
					pref [color=#2f4f4f]", "[/color]
					[b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 0 enx[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [color=#2f4f4f]", "[/color]
					[b][color=RED]([/color][/b]apply 'strcat [b][color=PURPLE]([/color][/b]mapcar 'rtos [b][color=TEAL]([/color][/b]cdr [b][color=OLIVE]([/color][/b]assoc 10 enx[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
				[b][color=BLUE])[/color][/b]
				#File
			[b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b][color=#8b4513]; repeat[/color]
		[b][color=MAROON]([/color][/b]close #File[b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]vla-ZoomPrevious [b][color=GREEN]([/color][/b]vlax-get-acad-object[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]if osm [b][color=GREEN]([/color][/b]setvar 'osmode osm[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]or a [b][color=GREEN]([/color][/b]setq a [color=#2f4f4f]"Yes"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]initget [color=#2f4f4f]"Yes No Y N"[/color][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]setq a [b][color=GREEN]([/color][/b]cond [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]getkword [b][color=PURPLE]([/color][/b]strcat [color=#2f4f4f]"\nDo you want to open the text file? [Yes/No] <"[/color] a [color=#2f4f4f]">: "[/color][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b] a [b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]member [b][color=BLUE]([/color][/b]strcase a[b][color=BLUE])[/color][/b] '[b][color=BLUE]([/color][/b][color=#2f4f4f]"Y"[/color] [color=#2f4f4f]"YES"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]startapp [color=#2f4f4f]"explorer"[/color] #FilePath[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b][color=#8b4513]; progn[/color]
[b][color=FUCHSIA])[/color][/b][color=#8b4513]; if[/color]

[b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b]
[b][color=BLACK])[/color][/b][color=#8b4513];| defun |; [b][color=BLACK]([/color][/b]vl-load-com[b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]princ[b][color=BLACK])[/color][/b] [/color]

Anyone feel free to modify it, in order to help the OP. (just keep these nicknames, as I appreciate what these guys taught me).

Link to comment
Share on other sites
robert61303 Newbie

robert61303

Posted
  • Author
Posted

Thanks guys!

 

@tombu:

The original lisp is to use ssget to select all the circle as you wrote, but I have further demand of putting different prefix before different groups of circle instead of all circle having the same prefix.

 

@Grrr:

The way to select the circle was great and the text file could choose to open or not. I just need to add function to label it.

 

:lol:

Link to comment
Share on other sites

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.

×
 Share
Go to topic listing
×
×
  • Create New...