Newb_to_Lsp Posted May 17, 2023 Posted May 17, 2023 (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? Quote
mhupp Posted May 18, 2023 Posted May 18, 2023 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 ".")) ) 1 Quote
ronjonp Posted May 18, 2023 Posted May 18, 2023 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) ) Quote
Newb_to_Lsp Posted May 18, 2023 Author Posted May 18, 2023 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.... Quote
mhupp Posted May 18, 2023 Posted May 18, 2023 (edited) 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 May 20, 2023 by mhupp 1 Quote
Newb_to_Lsp Posted May 20, 2023 Author Posted May 20, 2023 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 ".")) ) Quote
mhupp Posted May 20, 2023 Posted May 20, 2023 oops forgot to wrap it in itoa (princ (strcat "\n" (itoa (sslength SS)) " Objects Copied to layer " layerName2 ".")) 1 Quote
Newb_to_Lsp Posted May 22, 2023 Author Posted May 22, 2023 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. 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.