Community

Lisp Help - retrieve an inserts blockname

Lisp Help - retrieve an inserts blockname

gccdaemon
Collaborator Collaborator
615 Views
6 Replies
Message 1 of 7

Lisp Help - retrieve an inserts blockname

gccdaemon
Collaborator
Collaborator
‎01-20-2015 04:32 PM

I have a lisp routine that uses a SS to get a list of inserts (x-refs). The routine pulls the ssname of a single xref (XREF) from the xref list (XR) and does some other stuff.

 

What I don't know how to do is assign the blockname (dxf code 2) to a symbol (XRNAME) using the ssname of the xref (XREF).

 

I'm trying to pull the dxf code 2 string from a ssname of an xref so I can detach the xref once the main progn functions are done.

 

 (while	(= nil XR)
   (progn (princ "\nCommand: Select X-Refs or Blocks to copy objects from:")
      (setq XR (ssget '((0 . "INSERT"))))
   );progn
 );while
 (if XR
   (progn (setq ENTCNT 0)
      (while (/= ENTCNT (sslength XR))
         (setq REMSET (ssget "X"))
         (setq XREF (ssadd (ssname XR ENTCNT))
         (***main progn functions***)
         (command "-XREF" "D" XRNAME)
         (setq XREF nil)
         (setq REMSET nil)
         (setq ENTCNT (+ 1 ENTCNT))
      );While
   );progn
 ); if

 

Andrew Ingram
Civil 3D x64 2019
Win 10 x64 Pro
Intel Xeon E5-1620
32 GB Ram
0 Likes
Like
Report
Accepted solutions (1)
Solution 1
616 Views
6 Replies
Replies (6)
Message 2 of 7

Anonymous
Not applicable
‎01-20-2015 09:00 PM

Hi Andrew,

 

If you just want to extract the xref name, use

 

(setq XRNAME (cdr (assoc 2 (entget (ssname XR ENTCNT)))))

 

Regards,

gsktry

0 Likes
Like
Report
Message 3 of 7

gccdaemon
Collaborator
Collaborator
in reply to Anonymous
‎01-21-2015 08:27 AM

I'm getting an error. The number keeps changing, but it's the same error.

 

; error: bad argument type: listp <Selection set: 7b>

Andrew Ingram
Civil 3D x64 2019
Win 10 x64 Pro
Intel Xeon E5-1620
32 GB Ram
0 Likes
Like
Report
Message 4 of 7

Anonymous
Not applicable
in reply to gccdaemon
‎01-21-2015 08:42 AM

If possible post your modified code.

 

Regards,
gsktry

0 Likes
Like
Report
Message 5 of 7

gccdaemon
Collaborator
Collaborator
in reply to Anonymous
‎01-21-2015 01:43 PM

Here is the original working code:

 

(defun C:COPYX (/ CMD PICK1ST PT PNT POINTLIST XR XREF ENTCNT REMSET)
	(setq CMD (getvar "cmdecho"))
	(setq OSM (getvar "osmode"))
	(setq PICK1ST (getvar "pickfirst"))
	(setvar "cmdecho" 0)
	(STARTUNDO (ACADDOC))
	(setvar "pickfirst" 1)
	(setvar "osmode" 0)
	(setq XR nil)
	(while	(= nil XR)
		(progn	(princ "\nCommand: Select X-Refs to copy objects from:")
			(setq XR (ssget '((0 . "INSERT"))))))
	(princ "\nCommand: Select copy area:")
	(progn	(command "._select" "_cp")
		(while	(and	(setq PNT (getpoint))
				(listp PNT))
			(command PNT)
			(setq POINTLIST (cons PNT POINTLIST)))
		(command "" ""))
	(if XR	(progn	(setq ENTCNT 0)
			(while	(/= ENTCNT (sslength XR))
				(setq REMSET (ssget "X"))
				(setq XREF (ssadd (ssname XR ENTCNT)))
				(sssetfirst nil XREF)
				(command "_-refedit" "O" "N" "_CP")
				(foreach PT POINTLIST (command PT))
				(command "" "" "N")
				(command "_copy" "_CP")
				(foreach PT POINTLIST (command PT))
				(command "" "R" REMSET "" "0,0,0" "0,0,0")
				(command "_refset" "R" "_CP")
				(foreach PT POINTLIST (command PT))
				(command "" "")
				(command "_refclose" "D")
				(setq XREF nil)
				(setq REMSET nil)
				(setq ENTCNT (+ 1 ENTCNT))))
		(princ "\nNothing Selected. Exiting Function"))
	(princ "\nCommand: Done")
	(setvar "pickfirst" PICK1ST)
	(setvar "osmode" OSM)
	(ENDUNDO (ACADDOC))
	(setvar "cmdecho" CMD)
	(princ)
)

 

 

And here is the updated code:

 

 

(defun C:COPYX (/ CMD PICK1ST PT PNT POINTLIST XR XREF XRNAME ENTCNT REMSET YN)
	(setq CMD (getvar "cmdecho"))
	(setq OSM (getvar "osmode"))
	(setq PICK1ST (getvar "pickfirst"))
	(setvar "cmdecho" 0)
	(STARTUNDO (ACADDOC))
	(setvar "pickfirst" 1)
	(setvar "osmode" 0)
	(setq XR nil)
	(while	(= nil XR)
		(progn	(princ "\nCommand: Select X-Refs or Blocks to copy objects from:")
			(setq XR (ssget '((0 . "INSERT"))))))
	(princ "\nCommand: Select copy area:")
	(progn	(command "._select" "_cp")
		(while	(and	(setq PNT (getpoint))
				(listp PNT))
			(command PNT)
			(setq POINTLIST (cons PNT POINTLIST)))
		(command "" ""))
	(initget "Yes No")
	(setq YN (getkword "\nDetach selected X-Refs? [Yes/No] (No): "))
	(if XR	(progn	(setq ENTCNT 0)
 			(while	(< ENTCNT (sslength XR))
				(setq	REMSET (ssget "X"))
				(setq	XREF (ssadd (ssname XR ENTCNT)))
				(sssetfirst nil XREF)
				(setq	XRNAME (cdr (assoc 2 (ssadd (ssname XR ENTCNT)))))
				(command "_-refedit" "O" "N" "_CP")
				(foreach PT POINTLIST (command PT))
				(command "" "" "N")
				(command "_copy" "_CP")
				(foreach PT POINTLIST (command PT))
				(command "" "R" REMSET "" "0,0,0" "0,0,0")
				(command "_refset" "R" "_CP")
				(foreach PT POINTLIST (command PT))
				(command "" "")
				(command "_refclose" "D")
				(if	(= "Yes" YN)
					(command "-XREF" "D" XRNAME))
				(setq	XREF nil)
				(setq	XRNAME nil)
				(setq	REMSET nil)
				(setq	ENTCNT (+ 1 ENTCNT))
		)	)
		(princ "\nNothing Selected. Exiting Function")
	)
	(princ "\nCommand: Done")
	(setvar "pickfirst" PICK1ST)
	(setvar "osmode" OSM)
	(ENDUNDO (ACADDOC))
	(setvar "cmdecho" CMD)
	(princ)
)

 

Andrew Ingram
Civil 3D x64 2019
Win 10 x64 Pro
Intel Xeon E5-1620
32 GB Ram
0 Likes
Like
Report
Message 6 of 7

Anonymous
Not applicable
in reply to gccdaemon
‎01-21-2015 09:00 PM
Accepted solution

Hi,

 

I modified your code and it seems working. Check at your end.

 

(defun C:COPYX (/ )
  (setq CMD (getvar "cmdecho"))
  (setq OSM (getvar "osmode"))
  (setq PICK1ST (getvar "pickfirst"))
  (setvar "cmdecho" 1)

  (STARTUNDO (ACADDOC))

  (setvar "pickfirst" 1)
  (setvar "osmode" 0)
  (setq XR nil)
  (while (= nil XR)
    (progn
      (princ "\nCommand: Select X-Refs or Blocks to copy objects from:")
      (setq XR (ssget '((0 . "INSERT"))))
      )
    )

  (princ "\nCommand: Select copy area:")
  (progn
    (command "._select" "_cp")
    (setq POINTLIST ())
    (while (and	(setq PNT (getpoint)) (listp PNT))
      (command PNT)
      (setq POINTLIST (cons PNT POINTLIST))
      )

    (command "" "")
    )

  (initget "Yes No")
  (setq YN (getkword "\nDetach selected X-Refs? [Yes/No] (No): "))
  (if XR
    (progn
      (setq ENTCNT 0)
      (while (< ENTCNT (sslength XR))
	(setq	XRNAME (cdr (assoc 2 (entget (ssname XR ENTCNT)))))
	
	(setq	XREF (ssadd (ssname XR ENTCNT)))
	(sssetfirst nil XREF)
	
	(setq	XRNAME (cdr (assoc 2 (entget (ssname XR ENTCNT)))))

	(command "_-refedit" "O" "N" "cp")
	(foreach PT POINTLIST (command PT))
	(command "" "" "N")	

	(command "_copy" (ssget "wp" pointlist) "R" XREF "" "0,0" "0.0")

	(command "_refset" "R" "cp")
	(foreach PT POINTLIST (command PT))
	(command "" "")

	(command "_refclose" "D")
	
	(if (= "Yes" YN)
	  (command "-XREF" "D" XRNAME)
	  )
	
	(setq	XREF nil)
	(setq	XRNAME nil)
	(setq	REMSET nil)
	(setq	ENTCNT (+ 1 ENTCNT))
	)
      )
    (princ "\nNothing Selected. Exiting Function")
    )
  (princ "\nCommand: Done")
  (setvar "pickfirst" PICK1ST)
  (setvar "osmode" OSM)
  (ENDUNDO (ACADDOC))
  (setvar "cmdecho" CMD)
  (princ)
  )

Regards,

gsktry

 

 

 

Report
Message 7 of 7

gccdaemon
Collaborator
Collaborator
in reply to Anonymous
‎01-22-2015 10:16 AM

Looked through the routine and found a couple small changes. There was an extra "(setq POINTLIST ())" and an extra "(setq XRNAME (cdr (assoc 2 (entget (ssname XR ENTCNT)))))". Also changed the copy selection from "(ssget "WP" POINTLIST)" to "(ssget "CP" POINTLIST)".

 

As with anything I create it's all free, so do whatever you like with it. That being said, here is the final code and thanks for all the help!

 

;;----------------------------------------------------------------------------------------------------

;;----------------------------------------------------------------------------------------------------

(defun STARTUNDO ( doc )
    (ENDUNDO doc)
    (vla-startundomark doc)
)

;;----------------------------------------------------------------------------------------------------

(defun ENDUNDO ( doc )
	(while	(= 8 (logand 8 (getvar 'undoctl)))
		(vla-endundomark doc)
)	)

;;----------------------------------------------------------------------------------------------------

(defun ACADDOC nil
	(vl-load-com)
	(eval (list 'defun 'ACADDOC 'nil (vla-get-activedocument (vlax-get-acad-object))))
	(ACADDOC)
)
(princ)

;;----------------------------------------------------------------------------------------------------

(defun C:COPYX (/ CMD OSM PICK1ST YN XR XREF XRNAME POINTLIST PT PNT ENTCNT )
	(setq CMD (getvar "cmdecho"))
	(setq OSM (getvar "osmode"))
	(setq PICK1ST (getvar "pickfirst"))
	(setvar "cmdecho" 0)
	(STARTUNDO (ACADDOC))
	(setvar "pickfirst" 1)
	(setvar "osmode" 0)
	(setq XR nil)
	(while	(= nil XR)
		(progn	(princ "\nCommand: Select X-Refs to copy objects from:")
			(setq XR (ssget '((0 . "INSERT"))))))
	(princ "\nCommand: Select copy area:")
	(progn	(command "._select" "_cp")
		(while	(and (setq PNT (getpoint)) (listp PNT))
			(command PNT)
			(setq POINTLIST (cons PNT POINTLIST)))
		(command "" ""))
	(initget "Yes No")
	(setq YN (getkword "\nDetach selected X-Refs? [Yes/No] (No): "))
	(if XR	(progn	(setq ENTCNT 0)
			(while	(< ENTCNT (sslength XR))
				(setq	XRNAME (cdr (assoc 2 (entget (ssname XR ENTCNT)))))
				(setq	XREF (ssadd (ssname XR ENTCNT)))
				(sssetfirst nil XREF)
				(command "_-refedit" "O" "N" "cp")
				(foreach PT POINTLIST (command PT))
				(command "" "" "N")	
				(command "_copy" (ssget "CP" POINTLIST) "R" XREF "" "0,0,0" "0.0,0")
				(command "_refset" "R" "_CP")
				(foreach PT POINTLIST (command PT))
				(command "" "")
				(command "_refclose" "D")
				(if	(= "Yes" YN)
					(command "-XREF" "D" XRNAME))
				(setq	XREF nil)
				(setq	XRNAME nil)
				(setq	REMSET nil)
				(setq	ENTCNT (+ 1 ENTCNT))))
		(princ "\nNothing Selected. Exiting Function"))
	(princ "\nCommand: Done")
	(setvar "pickfirst" PICK1ST)
	(setvar "osmode" OSM)
	(ENDUNDO (ACADDOC))
	(setvar "cmdecho" CMD)
	(princ)
)

(princ "\n...Copy from Xref      : Type \"COPYX\" or \"CX\" to begin...")

 

 

Andrew Ingram
Civil 3D x64 2019
Win 10 x64 Pro
Intel Xeon E5-1620
32 GB Ram
0 Likes
Like
Report
Report a website issue