Jump to content

Creating a function to ncopy something(s) from xref and also store those objects as a variable


Newb_to_Lsp

Recommended Posts

(defun c:nc (/ *error* obj pt1 pt2)
  (setq obj (nentsel "\nSelect object(s) to copy: "))
  (setq pt1 '(0 0 0)) ;this hard codes in the values of 0,0,0
  (setq pt2 '(0 0 0)) ;this hard codes in the values of 0,0,0
  (command "_.ncopy" obj "" pt1 pt2)
)

This is the first portion of my routine that I am writing. The problem, or at least one of them, is that Cad doesn't seem to accept the values above. Ultimately, what I want is to be able to select and object(s) embedded in an xref, copy them into the current drawing file, move those object(s) to C-NPLT (checking to see if the layer exists, and creating it if it doesn't)

 

Everything I have so far is listed below. However, I know I likely have some other errors, but I can seem to get past the fact that the ncopy command is not actually coping anything over, and therefore it's hard to make out the other issues to resolve.

(defun c:nc (/ obj pt1 pt2 ent val layerName1 layerName2 layerExists)
  ;set varibles for each of the thress values needed using the ncopy command
  (setq obj (nentsel "\nSelect object(s) to copy: "))
  (setq pt1 '(0 0 0)) ;this hard codes in the values of 0,0,0
  (setq pt2 '(0 0 0)) ;this hard codes in the values of 0,0,0
  (command "_.ncopy" obj "" pt1 pt2)
  (setq ent (car obj))
  (setq val (cdr (assoc 8 (entget ent))))
  (setq layerName1 "layerName1")
  (setq layerName2 "C-NPLT")
  (setq layerExists (tblsearch "LAYER" layerName1))
  (if (not (tblsearch "LAYER" layerName2))
    (command "_-layer" "new" layerName2 "") ; Create the layer if it doesn't exist
  )
    (command "_.chprop" obj "" "LA" layerName2) ; Change layer of the copied object(s)
    (princ (strcat "\nObject(s) moved to layer " layerName2 "."))
)

 

Can anyone with some free time help me sort this out. :)  

 

Also do I need a loop in case there are multiple objects copying over?

Link to comment
Share on other sites

ncopy isn't in BricsCAD so I couldn't test this.

 

(defun c:nc (/ layerName2)
  (command "_.ncopy" "\\" "" "_non" '(0 0) "_non" '(0 0)) ;ncopy command with a pause for user selection. assumes you can select only one thing at a time.
  ;(setq lay (cdr (assoc 8 (entget (entlast)))))
  ;(setq layerName1 "layerName1")
  (setq layerName2 "C-NPLT")
  ;check if layer exist else make new layer.
  (or (tblsearch "LAYER" layerName2) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 layerName2) '(70 . 0) '(62 . 7)))) ;change 62 value for color
  (command "_.chprop" (entlast) "" "LA" layerName2) ; Change layer of the copied object(s)
  (princ (strcat "\nObject Copied to layer " layerName2 "."))
)

 

 

  • Like 1
Link to comment
Share on other sites

Give this a try:

(defun c:copyn (/ a b e el i la o ss tm)
  ;; RJP » 2022-11-29
  (sssetfirst nil (setq ss (ssadd)))
  (while (setq e (nentselp "Select nested object to copy: "))
    (cond
      ((wcmatch (setq a (cdr (assoc 0 (entget (car e))))) "ACAD_PROXY_ENTITY,VERTEX")
       (princ (strcat "\n" a " not supported..."))
      )
      ((not (setq tm (caddr e))) (princ (strcat "\n" a " item selected is not nested...")))
      ((setq el (entget (car e)))
       ;; Match layer properties after stripping out *| from name if found
       (and (setq la (entget (tblobjname "layer" (cdr (assoc 8 el)))))
	    (setq i (vl-string-position 124 (cdr (assoc 8 el)) 0 t))
	    (entmake (subst (cons 2 (setq b (substr (cdr (assoc 8 el)) (+ 2 i)))) (assoc 2 la) la))
       )
       (setq e (entmakex (append el
				 (list (cons 410 (getvar 'ctab))
				       (if i
					 (cons 8 b)
					 (assoc 8 el)
				       )
				 )
			 )
	       )
       )
       (vla-transformby (setq o (vlax-ename->vla-object e)) (vlax-tmatrix tm))
       (vla-update o)
       (ssadd e ss)
       (princ (strcat "\nEntity created [ " a " ]"))
      )
    )
  )
  (setvar 'cmdecho 0)
  (command "_.Draworder" ss "" "_Front")
  (setvar 'cmdecho 1)
  (sssetfirst nil ss)
  (princ)
)

 

Link to comment
Share on other sites

22 hours ago, mhupp said:

ncopy isn't in BricsCAD so I couldn't test this.

 

(defun c:nc (/ layerName2)
  (command "_.ncopy" "\\" "" "_non" '(0 0) "_non" '(0 0)) ;ncopy command with a pause for user selection. assumes you can select only one thing at a time.
  ;(setq lay (cdr (assoc 8 (entget (entlast)))))
  ;(setq layerName1 "layerName1")
  (setq layerName2 "C-NPLT")
  ;check if layer exist else make new layer.
  (or (tblsearch "LAYER" layerName2) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 layerName2) '(70 . 0) '(62 . 7)))) ;change 62 value for color
  (command "_.chprop" (entlast) "" "LA" layerName2) ; Change layer of the copied object(s)
  (princ (strcat "\nObject Copied to layer " layerName2 "."))
)

 

 

Yeah, that works pretty well. Only catch is that the ncopy command does normally accpet multiple objects. While in this routine however it does not. I'm not sure how to fix that.

 

Also need to make the layer a no plot layer if it creates it but I think I can look up the dotted pair info and add that in....

Link to comment
Share on other sites

On 5/18/2023 at 6:54 PM, Newb_to_Lsp said:

Only catch is that the ncopy command does normally accpet multiple objects. While in this routine however it does not. I'm not sure how to fix that.

 

This should do the trick. tho like usual @ronjonp's is better.

 

(defun c:nc (/ LastEnt SS layerName2)
  (setq LastEnt (entlast)) ;Sets a place maker anything created, copied, or moved will end up in the selection SS
  (setq SS (ssadd))
  (command "_.ncopy" (while (< 0 (getvar 'CMDACTIVE)) (command pause)) "" "_non" '(0 0) "_non" '(0 0)) 
  ;above keeps pausing allowing The user to make multiple selections. have to right click to exit.
  ;(setq lay (cdr (assoc 8 (entget (entlast)))))
  ;(setq layerName1 "layerName1")
  (setq layerName2 "C-NPLT")
  ;check if layer exist else make new layer.
  (or (tblsearch "LAYER" layerName2) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 layerName2) '(70 . 0) '(62 . 7))))  ;change 62 value for color
  (while (setq LastEnt (entnext LastEnt))  ;adds entitys to selection set SS
    (ssadd LastEnt SS)
  )
  (command "_.chprop" SS "" "LA" layerName2)  ; Change layer of the copied object(s)
  (princ (strcat "\n" (itoa (sslength SS)) " Objects Copied to layer " layerName2 "."))
)

 

 

Edited by mhupp
  • Like 1
Link to comment
Share on other sites

On 5/18/2023 at 6:37 PM, mhupp said:

 

This should do the trick. tho like usual @ronjonp's is better.

 

To be honest, I didn't fully understand ronjonp's code. It seemed like a re-write of the ncopy command itself. Cool, but not what I was after.

 

On 5/18/2023 at 6:37 PM, mhupp said:

 

(defun c:nc (/ LastEnt SS layerName2)
  (setq LastEnt (entlast)) ;Sets a place maker anything created, copied, or moved will end up in the selection SS
  (setq SS (ssadd))
  (command "_.ncopy" (while (< 0 (getvar 'CMDACTIVE)) (command pause)) "" "_non" '(0 0) "_non" '(0 0)) 
  ;above keeps pausing allowing The user to make multiple selections. have to right click to exit.
  ;(setq lay (cdr (assoc 8 (entget (entlast)))))
  ;(setq layerName1 "layerName1")
  (setq layerName2 "C-NPLT")
  ;check if layer exist else make new layer.
  (or (tblsearch "LAYER" layerName2) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 layerName2) '(70 . 0) '(62 . 7))))  ;change 62 value for color
  (while (setq LastEnt (entnext LastEnt))  ;adds entitys to selection set SS
    (ssadd LastEnt SS)
  )
  (command "_.chprop" SS "" "LA" layerName2)  ; Change layer of the copied object(s)
  (princ (strcat "\n" (sslength SS) " Objects Copied to layer " layerName2 "."))
)

 

 

This is closer but it was erroring out. That last line wasn't working so I put it back the way it was and made a couple other minor changes. What I have now seems to work with one minor exception: After that command pause is issued, the 0,0,0 values in the code are ignored. I have to type in the origin twice at the command line and then after that, the routine finishes up and correctly moves everything onto the C-NPLT layer. So the question is, do I need to issue some sort of unpause? lol

 

(defun c:nc (/ LastEnt SS layerName2)
  (setq LastEnt (entlast)) ;Sets a place maker anything created, copied, or moved will end up in the selection SS
  (setq SS (ssadd))
  (command "_.ncopy" (while (< 0 (getvar 'CMDACTIVE)) (command pause)) "" "_non" '(0 0) "_non" '(0 0)) 
  ;above keeps pausing allowing The user to make multiple selections. have to right click to exit.
  (setq layerName2 "C-NPLT")
  ;check if layer exist else make new layer.
  (or (tblsearch "LAYER" layerName2)
      (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 layerName2) '(70 . 0) '(62 . 1))))  ;change 62 value for color
  (while (setq LastEnt (entnext LastEnt))  ;adds entitys to selection set SS
    (ssadd LastEnt SS)
  )
  (command "_.chprop" SS "" "LA" layerName2 "")  ; Change layer of the copied object(s)
  (princ (strcat "\nObjects Copied to layer " layerName2 "."))
)

 

Link to comment
Share on other sites

oops forgot to wrap it in itoa

 

(princ (strcat "\n" (itoa (sslength SS)) " Objects Copied to layer " layerName2 "."))

 

  • Like 1
Link to comment
Share on other sites

Quote
On 5/20/2023 at 12:14 PM, mhupp said:

oops forgot to wrap it in itoa

 

(princ (strcat "\n" (itoa (sslength SS)) " Objects Copied to layer " layerName2 "."))

 

 

Nice. I get what you were doing there now.

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.

×
×
  • Create New...