Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 12/07/2022 in all areas

  1. Maybe this ... it produces a tighter result without the spaces: (apply 'strcat (mapcar '(lambda (x) (cond ((and (= 43 x) (null f)) "\\P") ((= 40 x) (setq f t) (chr x)) ((= 41 x) (setq f nil) (chr x)) ((= 32 x) "") ((chr x)) ) ) (vl-string->list "1.35 x 2.94 + 6.16 x 4.19 + 2.94 x 1.25 + 1/2 x (1.84 + 2.08) x 3.74") ) )
    2 points
  2. Or using member: (if (member (cdr (assoc 0 (setq e (entget sn)))) '("MTEXT" "TEXT"))
    2 points
  3. This will round up any divide number that is in range of ##.99 - ##.01 And will also save the variable in the drawing as Ldata so it can be recalled the next time the command is run. If you want to use the number between the brackets just hit enter Specify Distance [200]: (defun c:@Dims (/ D dist SS eo len div) (or (setq D (vlax-ldata-get "Distance" "D")) (setq D 200.0)) ;set D with numbers not strings "200.0" (if (setq dist (getdist (strcat "\nSpecify Distance [" (rtos D 2 0) "]: "))) (vlax-ldata-put "Distance" "D" dist) ;updates with new distance (vlax-ldata-put "Distance" "D" (setq dist D)) ;sets dist to D also updates ldata ) (if (setq SS (ssget '((0 . "DIMENSION")))) (foreach dim (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq eo (vlax-ename->vla-object dim)) (setq len (vlax-get eo 'Measurement)) (if (> (- (/ len dist) (setq div (fix (/ len dist)))) 0.009) (setq div (1+ (fix (/ len dist)))) ) (vla-put-TextOverride eo (strcat (rtos len 2 0) "/" (rtos dist 2 0) " = " (rtos div 2 0) " Spaces")) ) (vla-Regen (vla-get-ActiveDocument (vlax-get-Acad-Object)) acActiveViewport) ;regen active viewport (princ) ) (princ) )
    2 points
  4. Replace (if (eq (cdr (assoc 0 (setq e (entget sn)))) "TEXT,MTEXT") with (if (or (eq (cdr (assoc 0 (setq e (entget sn)))) "TEXT") (eq (cdr (assoc 0 (setq e (entget sn)))) "MTEXT"))
    2 points
  5. So this should work on the examples above: (defun c:newline ( / MyEnt oldtext textlist acount newtext temptext) (defun LM:str->lst ( str del / pos ) ;;http://lee-mac.com/stringtolist.html (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) ) ) (setq MyEnt (ssname (ssget "_+.:E:S" '((0 . "MTEXT"))) 0)) ;; Select only single mtext (setq oldtext (cdr (assoc 1 (entget MyEnt)))) ;; get text string (up to 256 characters) (setq textlist (LM:str->lst oldtext "+")) ;; make list, remove all '+' (setq acount 0) ;; just a counter (setq newtext "") ;; blank text string (while (< acount (length textlist)) ;; while loop, looping through list of texts (setq temptext (vl-string-left-trim " " (vl-string-right-trim " " (nth acount textlist)) )) ;; trim spaces (setq newtext (strcat newtext temptext)) ;; create new text (setq acount (+ acount 1)) (if (wcmatch (nth (- acount 1) textlist) "*(*" ) ;; if bracket, return a + else a new line (setq newtext (strcat newtext " + ")) (setq newtext (strcat newtext "\\P")) ) ; end if ) ; end while (entmod (subst (cons 1 newtext) (assoc 1 (entget MyEnt)) (entget MyEnt) )) ;; Uodate text (princ) )
    1 point
  6. Just off the top of my head, no proper thinking done yet. In the case of 1/2 x (1.84 + 2.88) x 3.74. I have used Lee Macs string to list before doing a similar text replace, the deliminator in this case being the '+', then recombining it with a strcat and whatever I want to put in between the list items. Would give a list ( ("2.94 x 1.25") ("1/2 x (1.84") ("2.08 ) x 3.74") Then do an if and wcmatch, to decide if the + should be replaced by a new line or left as a + Just thinking out loud
    1 point
  7. I don't know about that one. Maybe ask if you want to Continue? But you would have to hit enter or right click each time. so maybe NLAdv ? NLADV Replace Text: + Select Text: Continue? [<Yes>/No]: Continue? [<Yes>/No]: Continue? [<Yes>/No]: n (defun C:NLAdv (/ replace txt obj text) (setq replace (getstring "\nReplace Text: " T)) (setq txt (vlax-ename->vla-object (car (entsel "\n Select Text: ")))) (setq rep "Yes") (while (eq rep "Yes") (vla-put-textstring txt (vl-string-subst "\\P" replace (vla-get-textstring txt))) (if (vl-string-search replace (setq text (vla-get-textstring txt))) (progn (initget "Yes No") (setq rep (cond ((getkword "\nContinue? <Yes>/No: ")) ( "Yes") ) ) ) (setq rep "No") ) ) (princ) ) --EDIT Prob just easier to make an undo mark after each text string update. Then you can undo the last change. (defun C:NL (/ replace txt text) (vl-load-com) (setq Drawing (vla-get-activedocument (vlax-get-acad-object))) (setq replace (getstring "\nReplace Text: " T)) (setq txt (vlax-ename->vla-object (car (entsel "\n Select Text: ")))) (while (vl-string-search replace (setq text (vla-get-textstring txt))) ;search string for replace value (vla-startundomark Drawing) (vla-put-textstring txt (vl-string-subst "\\P" replace (vla-get-textstring txt))) (vla-endundomark Drawing) ) ) NL 1.35 x 2.94 6.16 x 4.19 2.94 x 1.25 1/2 x (1.84 2.08) x 3.74 undo or ctrl Z 1.35 x 2.94 6.16 x 4.19 2.94 x 1.25 1/2 x (1.84 + 2.08) x 3.74
    1 point
  8. I think he wants the + to be a new line Ronjonp the replace I inputted was " + " or you wouldn't line up if it was just "+" (defun C:NEWLINE (/ replace txt text) (setq replace (getstring "\nReplace Text: " T)) (setq txt (vlax-ename->vla-object (car (entsel "\n Select Text: ")))) (while (vl-string-search replace (setq text (vla-get-textstring txt))) ;search string for replace value (vla-put-textstring obj (vl-string-subst "\\P" replace (vla-get-textstring txt))) ) )
    1 point
  9. (vl-string-translate " x " " + " "1.61 x 1.35 + 1.11 x 4.28 + 2.89 x 2.63") ;; "1.61 + 1.35 + 1.11 + 4.28 + 2.89 + 2.63"
    1 point
  10. I downloaded the AL postcode , of course is huge . I strip the header and 2 first PC. It have all data , 53 columns, and 7779 rows + head PostcodeIn Use?LatitudeLongitudeEastingNorthingGrid RefCounty AL1 1AGYes51.74529-0.328628515487206498TL154064Hertfordshire AL1 1AJYes51.744498-0.328599515491206410TL154064Hertfordshire AL postcodes - header and first 2 .csv AL postcodes.csv
    1 point
  11. If more than 1 select is done during the stretch command, or if a "C", "W", "CP", etc. modifier is used, then you need to loop the pause until the command is ended. See my small modification to mhupp's code. (defun C:S (/ layer) (vla-put-lock (setq layer (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) "Construction_Layer") :vlax-true) (command "_.Stretch") ;; Loop until command has ended. (while (= (logand (getvar "cmdactive") 1) 1) (command pause) ) (vla-put-lock layer :vlax-false) )
    1 point
  12. Try it and see - best way to learn what works! Remembering to call each a unique name and reference within the LISP By way of example, from Lee Mac - commenting out some of the nice stuff he puts in (defun c:writetextfile ( / des txt ) ;; Define function, declare local variables ;; (if (setq txt (getfiled "Create Text File" "" "txt" 1)) ;; Prompt user for filename/filepath ;; (progn (setq txt1 (getfiled "Create Text File" "" "txt" 1)) (setq txt2 (getfiled "Create Text File" "" "txt" 1)) (setq txt3 (getfiled "Create Text File" "" "txt" 1)) ;; (if (setq des (open txt "w")) ;; Attempt to create text file with given filename/filepath (progn ;; Evaluate the enclose expressions as the 'then' expression for the IF statement (setq des1 (open txt1 "w")) ;; Attempt to create text file with given filename/filepath (setq des2 (open txt2 "w")) ;; Attempt to create text file with given filename/filepath (setq des3 (open txt3 "w")) ;; Attempt to create text file with given filename/filepath (write-line "This is a test 1." des1) ;; Write line of text to text file (write-line "This is a test 2." des2) ;; Write line of text to text file (write-line "This is a test 3." des3) ;; Write line of text to text file (close des3) ;; Close file descriptor (close des2) ;; Close file descriptor (close des1) ;; Close file descriptor ) ;; end PROGN ;; (princ "\nUnable to create text file.") ;; Else the text file could not be created ;; ) ;; end IF ;; (princ "\n*Cancel*") ;; Else the user pressed Cancel ;; ) ;; end PROGM ;; ) ;; end IF (princ) ;; Suppress the return of the last evaluated expression ) ;; end DEFUN
    1 point
  13. The CSV from OS CodePoint does not show Lat & Long. The OS grid is a Transverse Mercator one which only has Eastings and Northings. The "TL" is a reference to the grids. The first character comes from the 500 kilometre grid reference and the second character comes from the 100 kilometre grid reference. I looked on the OS web site for a table that gives the actual numbers, and could not find one - I may have been looking in the wrong place. However, I thought to make a csv table which contains all the references. Some of the 100 km squares are water only, so contain no OS data. Do check if you can because this is all my own work! HL,0,1200000 HM,100000,1200000 HN,200000,1200000 HO,300000,1200000 HP,400000,1200000 JL,500000,1200000 HQ,0,1100000 HR,100000,1100000 HS,200000,1100000 HT,300000,1100000 HU,400000,1100000 JQ,500000,1100000 HV,0,1000000 HW,100000,1000000 HX,200000,1000000 HY,300000,1000000 HZ,400000,1000000 JV,500000,1000000 NA,0,900000 NB,100000,900000 NC,200000,900000 ND,300000,900000 NE,400000,900000 OA,500000,900000 NF,0,800000 NG,100000,800000 NH,200000,800000 NJ,300000,800000 NK,400000,800000 OF,500000,800000 NL,0,700000 NM,100000,700000 NN,200000,700000 NO,300000,700000 NP,400000,700000 OL,500000,700000 NQ,0,600000 NR,100000,600000 NS,200000,600000 NT,300000,600000 NU,400000,600000 OQ,500000,600000 NW,100000,500000 NX,200000,500000 NY,300000,500000 NZ,400000,500000 OV,500000,500000 OW,600000,500000 SB,100000,400000 SC,200000,400000 SD,300000,400000 SE,400000,400000 TA,500000,400000 TB,600000,400000 SG,100000,300000 SH,200000,300000 SJ,300000,300000 SK,400000,300000 TF,500000,300000 TG,600000,300000 SM,100000,200000 SN,200000,200000 SO,300000,200000 SP,400000,200000 TL,500000,200000 TM,600000,200000 SQ,0,100000 SR,100000,100000 SS,200000,100000 ST,300000,100000 SU,400000,100000 TQ,500000,100000 TR,600000,100000 SV,0,0 SW,100000,0 SX,200000,0 SY,300000,0 SZ,400000,0 TV,500000,0
    1 point
  14. Hi mhupp, it work´s very fine. Thank for your help.
    1 point
  15. Yes. But there might be other types of text, such as ARCTEXT (or was it RTEXT? Can't remember LOL).
    1 point
  16. You could also go with: (if (wcmatch (cdr (assoc 0 (setq e (entget sn)))) "TEXT,MTEXT")
    1 point
  17. One definition of block A in the block library, But you can have multiples of block A in the drawing. This should be what your looking for. Added two other lisp that will dump properties of selected items into command prompt. dumpit = dxf codes Vdumpit = visual lisp propeties ;;----------------------------------------------------------------------;; ;; Select Block by Name (defun C:SBN (/ blkname SS) (setq blkname (cdr (assoc 2 (entget (car (entsel "\nSelect Block")))))) ;Gets block name to use in ssget filter (if (setq SS (ssget (list '(0 . "INSERT") (cons 2 blkname)))) ;will only select blocks of the same name (sssetfirst nil SS) ) (princ) ) ;;----------------------------------------------------------------------------;; ;; Dump all methods and properties for selected objects (defun C:VDumpIt (/ ent) (while (setq ent (car (entsel "\nSelect Entity to Dump"))) (vlax-Dump-Object (vlax-Ename->Vla-Object ent) t) ) (textscr) (princ) ) ;;----------------------------------------------------------------------------;; ;; Dump all DXF Group Data (defun C:DumpIt (/ ent) (while (setq ent (car (entsel "\nSelect Entity to Dump"))) (mapcar 'print (entget ent '( "*"))) ) (textscr) (princ) )
    1 point
×
×
  • Create New...