Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 03/23/2022 in all areas

  1. I knew I had seen something this by PBE here at cadtutor 2014, copy paste code to command line you may be surprised what you get. (setq txtstring (vlax-invoke (vlax-get (vlax-get (setq 2ClipB (vlax-create-object "htmlfile")) 'ParentWindow ) 'ClipBoardData ) 'GetData "Text" ) ) The problem is the clip data may not be text. line 1 line 2 line 3 Returns ("line 1\r\nline2\r\nline 3") Just a side note if you debug a text file you will find in hex ODOA on end of line this is carriage return & line feed which looks like it matches \r\n
    4 points
  2. in my lisp collection i have this, but not remember the original source for give credit (defun c:color2layer (/ atts doc lay lays lokt) (defun laycheck (ent color / lay) (if (< 0 color 256) (progn (setq lay (vla-add lays (strcat "Color-" (itoa color)))) (vla-put-layer ent (vla-get-name lay)) (vla-put-color lay color) (vla-put-color ent acbylayer) ) ) ) (setq doc (vla-get-activedocument (vlax-get-acad-object)) lays (vla-get-layers doc) ) (vlax-for lay lays ;;check for locked layers (if (eq :vlax-true (vla-get-lock lay)) (progn (setq lokt (cons (vla-get-name lay) lokt)) (vla-put-lock lay :vlax-false) ) ) ) (vla-startundomark doc) (vlax-for blk (vla-get-blocks doc) (if (and (eq (vla-get-isxref blk) :vlax-false) (not (vl-string-search "|" (vla-get-name blk))) ) (progn (vlax-for ent blk (laycheck ent (vla-get-color ent)) (if (and (vlax-property-available-p ent "hasattributes") (vla-get-hasattributes ent) (setq atts (vlax-invoke ent "getattributes")) ) (progn (foreach att atts (laycheck att (vla-get-color att)) (vla-update att) ) ) ) ) ) ) ) (if lokt ;;reset locked layers (foreach lay lokt (vla-put-lock (vla-item lays lay) :vlax-true) ) ) (vla-endundomark doc) (princ "\nDone!") (princ) )
    2 points
  3. i'm glad to you success as like BIGAL said, ₩r₩n = enter key like typing machine move cursor(carriage) return to leftside of line = ₩r scroll paper to make new line (line feed) = ₩n os paste that automatically when i copy multiline text to clipboard, every enter so when run my c:cbread, that will show copied text with ₩r₩n in autocad mtext also apply ₩r₩n as enter we do that simply ₩n without ₩r so, your original code cannot find ₩₩n ₩₩r. because double ₩₩ is no there. not like dcl. i think
    1 point
  4. I think I got what I wanted working now, I added in an 'if' and vl-string-search pretty much copied from Lee Macs LM:Str-Lst with a slight change and it all worked. I think also using \r\n helped but not sure why. Used all of your help above in parts, thanks. Anyway below just for completion this is my basic clipboard to text LISP with my question answered, Command txtcbnew will ask the user for an insertion point then paste a new text there, muiltiline or dtext according to the clipboard. (defun c:txtcbnew ( / MorDor newtext font textheight InsertPoint pos) (setq font (getvar "textstyle")) (setq textheight (getvar 'TEXTSIZE)) (setq newtext (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'getData "TEXT" ) ) (if (setq pos (vl-string-search "\r\n" newtext)) (setq MorDor "M") (setq MorDor "D") ) ;; (initget "M D") ;; (setq MorDor (getkword "\nM or D Text (M/D): ")) (setq InsertPoint (getpoint "insertion Point")) (createtext newtext InsertPoint font textheight MorDor) ;;lisp to make text (princ) ) (defun createtext ( MyText TextPoint font textheight MorD / ) (if (= MorD "D") (progn (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbText") (cons 10 TextPoint) (cons 40 textheight) (cons 1 MyText) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0) (cons 7 font) '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0) '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0) ));end list, entmake ) ;end progn (progn ;;(defun createmtext (MyText TextPoint font textheight / ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 TextPoint) (cons 40 textheight) (cons 1 MyText) ));end list, entmake );end progn );end if )
    1 point
  5. I merged PBE's code with my old code. it was created by modifying existing text, but it shouldn't be difficult to create a new text. maybe ; CBPASTE - 2022.03.23 exceed ; this lisp is using the code from this link. GetClipText by Patrick_35 ( http://www.theswamp.org/index.php?topic=21764.msg263108#msg263108 ) ; Only minor modifications have been made so that it can be run as a command. ; command list ; cbread - view clipboard texts in command line ; cbpaste - paste clipboard texts to text object (vl-load-com) (defun c:cbread ( / txtstring ) (setq txtstring (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'GetData "Text")) (print txtstring) (princ) ) (defun c:cbpaste ( / *error* txtstring txtedit1 rowcount rowlast scstack index selectedrow selectedrowlist srllen subindex selectedcell sclist ss1stacklist ss1count ss2 ss2count ss2index ss2y ss2list ss2stacklist ss2ent ss2x ss2index2 ss1textfromstacklist ss2obj ss1notusedlist ss1notusedstacklist ss1notusedlength ss1notusedindex ss1notusedtextstr ss1notusedtext ss1notusedtextstrlen ) (setvar 'cmdecho 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (setvar 'cmdecho 1) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (setq txtstring (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'GetData "Text")) ;(princ "\n original clipboard text - \n") ;(print txtstring) (setq txtedit1 (LM:str->lst txtstring "\r\n")) ;(princ "\n line break text - \n") ;(print txtedit1) (setq rowcount (length txtedit1)) (setq rowlast (last txtedit1)) (if (= rowlast "") (setq rowcount (- rowcount 1)) (setq rowcount rowcount) ) (setq scstack '()) (setq index 0) (repeat rowcount (setq selectedrow (nth index txtedit1)) ;(princ "\n selectedrow - ") ;(print selectedrow) (setq selectedrowlist (LM:str->lst selectedrow "\t")) ;(princ "/ selectedrowlist - ") ;(print selectedrowlist) (setq srllen (length selectedrowlist)) ;(princ "/ srllen - ") ;(princ srllen) (setq subindex 0) (repeat srllen (setq selectedcell (nth subindex selectedrowlist)) (setq sclist '()) (setq sclist (list index selectedcell subindex)) (setq scstack (cons sclist scstack)) (setq subindex (+ subindex 1)) );end of repeat (setq index (+ index 1)) ) ;(princ "\n scstack - ") ;(princ scstack) (setq ss1stacklist (mysort scstack)) ;(princ "\n sorted scstack - ") ;(princ scstack) (setq ss1count (length ss1stacklist)) (princ "\n Select the object texts to be pasted \n") ;select object texts (setq ss2 (ssget '((0 . "*TEXT"))) ) (setq ss2count (sslength ss2)) (setq ss2index 0) (setq ss2y 0) (setq ss2list nil) (setq ss2stacklist nil) ;get list of object texts ( y-coordinate index ) (repeat ss2count (setq ss2ent (entget (ssname ss2 ss2index))) (setq ss2y (atoi (rtos (* (nth 2 (assoc 10 ss2ent)) -1) 2 2))) ; * -1 for reverse y coordinates (for sorting) (setq ss2x (atoi (rtos (nth 1 (assoc 10 ss2ent)) 2 2)) ) (setq ss2list (list ss2y ss2index ss2x)) (setq ss2stacklist (cons ss2list ss2stacklist)) (setq ss2index (+ ss2index 1)) ) ;(princ "\n objectlist = ") ;(princ ss2stacklist) (setq ss2stacklist (mysort ss2stacklist)) ;(princ "\n sorted objectlist = ") ;(princ ss2stacklist) ;if object list has more member than original list, add "___" at the end of original list, ;to avoid errors, this part should precede the put-text loop. (if (> ss2count ss1count) (progn (repeat (- ss2count ss1count) (setq ss1stacklist (append ss1stacklist (list (list 0 "___" 0)) )) ) ) ) ;put the value (setq ss2index2 0) (setq ss1textfromstacklist nil) (repeat ss2count (setq ss1textfromstacklist (LM:UnFormat (cadr (nth ss2index2 ss1stacklist)) nil) ) ;to Paste (if (= ss1textfromstacklist "") (setq ss1textfromstacklist "___")) (setq ss2obj (vlax-ename->vla-object (ssname ss2 (cadr (nth ss2index2 ss2stacklist)) ))) (vla-put-textstring ss2obj ss1textfromstacklist) (setq ss2index2 (+ ss2index2 1)) );end repeat ;make not used list (if original members more than object members) (setq ss1notusedlist nil) (setq ss1notusedstacklist nil) (if (< ss2count ss1count) (progn (repeat (- ss1count ss2count) (setq ss1notusedlist (nth ss2index2 ss1stacklist)) (setq ss1notusedstacklist (cons ss1notusedlist ss1notusedstacklist)) (setq ss2index2 (+ ss2index2 1)) ) ) ) ;sort not used list (setq ss1notusedstacklist (vl-sort ss1notusedstacklist (function (lambda (x1 x2)(< (car x1) (car x2))) ) ) ) ;make string for not used list (setq ss1notusedlength (length ss1notusedstacklist)) (setq ss1notusedindex 0) (setq ss1notusedtextstr "\n Not used original texts = ") (repeat ss1notusedlength (setq ss1notusedtext (LM:UnFormat (vl-princ-to-string (cadr (nth ss1notusedindex ss1notusedstacklist))) nil)) (setq ss1notusedtextstr (strcat ss1notusedtextstr ss1notusedtext ", " )) (setq ss1notusedindex (+ ss1notusedindex 1)) ) ;delete ", " end of str (setq ss1notusedtextstrlen (strlen ss1notusedtextstr)) (setq ss1notusedtextstr (substr ss1notusedtextstr 1 (- ss1notusedtextstrlen 2))) ;result message (princ (strcat "\n Original Texts : " (vl-princ-to-string ss1count) " ea / Object Texts : " (vl-princ-to-string ss2count) " ea \n")) (cond ((> ss1count ss2count) (princ (strcat "\n Copying the contents of " (vl-princ-to-string ss2count) " texts is Complete. / " (vl-princ-to-string (- ss1count ss2count)) " ea original texts are not used." ss1notusedtextstr ))) ((< ss1count ss2count) (princ (strcat "\n Copying the contents of " (vl-princ-to-string ss1count) " texts is Complete. / " (vl-princ-to-string (- ss2count ss1count)) " ea object texts are left. not enough original texts. they are replaced by ___"))) ((= ss1count ss2count) (princ (strcat "\n Copying the contents of " (vl-princ-to-string ss2count) " texts is Complete. / The number of object and original is the same."))) ) (setvar 'cmdecho 1) (LM:endundo (LM:acdoc)) (princ) ) (defun mysort ( l ) (vl-sort l '(lambda ( a b ) (if (eq (car a) (car b)) (< (caddr a) (caddr b)) (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b))) ) ) ) ) ;; String to List - Lee Mac ;; Separates a string using a given delimiter ;; str - [str] String to process ;; del - [str] Delimiter by which to separate the string ;; Returns: [lst] List of strings (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright ⓒ 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) (princ "\n CBPASTE - loading complete") CBPASTE - copy from 1 column texts in PDF - case 1 : original texts quantity = object texts quantity - case 2 : original texts quantity < object texts quantity, the remaining object texts in cad are changed to "___". - case 3 : original texts quantity > object texts quantity, prints the contents of the remaining original text to the command prompt. CBPASTE - copy from excel - similar to the case of pdf. The only difference is that empty cells are replaced with "___". This is because when I change the value of text to "" in cad the text disappears.
    1 point
  6. I don't think that you can search a string in the clipboard so after pasting the value into a text object then you can implement your procedures / tricks on it.
    1 point
  7. You could also use strcase on testA to eliminate any case sensitivity. (setq x "ni") (setq y "T0") (setq z "r") (setq d "_") (setq testA (strcase (strcat x d y d z))) testA = "NI_T0_R"
    1 point
  8. I'm guessing this is just a test lisp and x y x will be set in some other way? unless the inputs change it will always have the same output. Looking at your code its always going to say "Layer = Layer not defined, cond failed" because you set nLay in the start but then don't redefine it in any of the cond's Some more reading on the topic. (defun c:foo4 ( / x y z d nLay testA TestB nTLs nLIy) ;list variables you are using (setq x "NI") (setq y "T0") (setq z "R") ;I for cond 1, C for cond 3 (setq d "_") (setq testA (strcat x d y d z)) (setq testB "NI_T0_I") (princ (strcat "\n\"" TestA "\" vs \"" TestB "\"")) ; \" to use quotes in lisp (if (= TestA TestB) (princ "\nIs A Equal B =Yes") (princ "\nIs A Equal B = NO") ) (cond ((= testA "NI_T0_I" ) (setq nLTs 10) (setq nLIy "I_T0") (setq nLay "\nCondtion One Met \nLayer is \"I_T0\"") ) ((= testA "NI_T0_R" ) ;don't need (progn (setq nLTs 10) (setq nLIy "T0-R") (setq nLay "\nCondtion Two Met \nLayer is \"T0-R\"") ) ((= testA "NI_T0_C" ) (setq nLTs 10) (setq nLIy "T0-Test") (setq nLay "\nCondtion Three Met \nLayer is \"T0-Test\"") ) (t ;this is a better place to put the fail statment. (setq nLay "Layer Not Defined, All Cond's Failed") ) ) (princ "\nLayer = ") (princ nLay) (princ) )
    1 point
  9. @valljenYou can use qselect to select only dims and then in the list of properties find 'associative' and choose partial (then change the layer or color in properties until you have fixed each dim makes it easy to go through them all).
    1 point
  10. I used the LAYISO command to isolate all the dimensions (just for visual clarification), didn't really NEED to do that, I could have, and normally do leave all layers on when doing this. After Saving > Closing and reopening the .dwg, thos dimensions are shown as NON-Associative, and show what I assume to be accurate Dims. I am guessing that SUDY (as rev clouded in the seconf screenshot) is meant to be STUDY? Perhaps this might be of further assistance? This System Variable setting can also be founf in OPTIONS, an the DRAFTING Tab. Be sure to remember to click Apply and OK after making changes in these dialog boxes.
    1 point
  11. This thread seems to be veering off topic. Maybe try to reinstall AutoCAD 2005, it may fix whatever issues the last update to Windows 10 was that caused the problem. When Windows 10 first came out, a co-worker needed AutoCAD 2004 loaded on his personal laptop and was having trouble with it, I removed all Autodesk products completely, ran CCLeaner on it and turned off UAC then reinstalled and it ran flawlessly after that. Far out guess, maybe try using a different drive letter to map the drive. You never know. I'll try to see if my 2000i at home as any problems since last update.
    1 point
  12. Hi Bill, I program nearly everything now in Bricscad V20 there are a couple of commands that work differently such as Polygon, but I dont have any problems, many years ago wrote for Intellicad and had a couple of hiccups but worked out what they were. I ahve some older software like 1990 and it works fine it has like 130 modules. Oh yeah another is loading line types looks for default.lin or iso.lin, set or get property does not work. The VLA command as referenced by the Bricscad team has added around support for 200 vl functions. Maybe need a list of what does not work.
    1 point
  13. I tried BricsCAD way back in 2015. It was nice and had an interface that you could make look just like AutoCAD. But when it came to LISP, I had troubles. At that time I was working as a full-time LISP developer and some of my programs were several thousand lines long. They worked perfectly in AutoCAD but when I tried them on BricsCAD it would crash. They may have worked out the bugs by now. I haven't tried it since 2015.
    1 point
  14. Sorry to weigh in late on this one. I worked many a year in IT for large companies. We used Novell and Windows servers. Since your original post referenced a network drive, that's not exactly the same things as an external drive. Either way, once you achieve a drive mapping to the drive whether it's external or a network drive, you should be able to access it even with AutoCAD 2005. To diagnose, I would check that you have the drive mapped and a letter assigned to it. And remember, what one user calls drive H:\ may not be the same on another workstation.
    1 point
×
×
  • Create New...