Jump to content

Leaderboard

  1. BIGAL

    BIGAL

    Trusted Member


    • Points

      34

    • Posts

      18,343


  2. Steven P

    Steven P

    Trusted Member


    • Points

      26

    • Posts

      2,395


  3. pkenewell

    pkenewell

    Community Member


    • Points

      22

    • Posts

      559


  4. mhupp

    mhupp

    Trusted Member


    • Points

      21

    • Posts

      1,941


Popular Content

Showing content with the highest reputation since 05/12/2024 in all areas

  1. ; slope - 2024.05.28 exceed (defun c:SLOPE ( / acdoc mspace fuzz ssp sspl i ptlist ent entlist pt ss ssl obj coordlist coordlistlen p1 p2 xydist midpt parameter totallen midlen j p1z p2z flag1 flag2 pt2 sloperatio slopeblock blkang slopetextpt slopetext lengthtextpt lengthtext midparam prevparam nextparam) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq mspace (vla-get-modelspace acdoc)) (setq fuzz 0.005) (setq ssp (ssget "X" '((0 . "POINT")))) (setq sspl (sslength ssp)) (setq i 0) (setq ptlist '()) (repeat sspl (setq ent (ssname ssp i)) (setq entlist (entget ent)) (setq pt (cdr (assoc 10 entlist))) (setq ptlist (cons pt ptlist)) (setq i (+ i 1)) ) ;(princ "\n pt list - ") ;(princ ptlist) (setq ss (ssget '((0 . "LWPOLYLINE") (8 . "-Polyline-")))) (setq ssl (sslength ss)) (setq i 0) (repeat ssl (setq ent (ssname ss i)) (setq obj (vlax-ename->vla-object ent)) (setq coordlist (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'coordinates)))) (setq coordlistlen (length coordlist)) (setq p1 (list (car coordlist) (cadr coordlist) 0)) (setq p2 (list (nth (- coordlistlen 2) coordlist) (nth (- coordlistlen 1) coordlist) 0)) (setq xydist (distance p1 p2)) (setq midpt '()) (setq param (vlax-curve-getEndParam obj)) (setq totallen (vlax-curve-getDistAtParam obj param)) (setq midlen (* 0.5 totallen)) (setq midpt (vlax-curve-getPointAtDist obj midlen)) ;(setq midparam (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj midpt))) ;(setq prevparam (vlax-curve-getPointAtParam obj (fix midparam))) (setq prevparam (vlax-curve-getpointatdist obj (* 0.499999 totallen))) ;(setq nextparam (vlax-curve-getPointAtParam obj (+ (fix midparam) 1))) (setq nextparam (vlax-curve-getpointatdist obj (* 0.500001 totallen))) ;(princ midpt) (setq j 0) (setq p1z 0) (setq p2z 0) (setq flag1 0) (setq flag2 0) (repeat sspl (setq pt2 (nth j ptlist)) (if (and (and (< (- (car p1) fuzz) (car pt2)) (< (car pt2) (+ (car p1) fuzz))) (and (< (- (car p1) fuzz) (car pt2)) (< (cadr pt2) (+ (cadr p1) fuzz))) (= flag1 0) ) (progn (setq p1z (caddr pt2)) ;(princ "\n p1z = ") ;(princ p1z) (setq flag1 1) ) ) (if (and (and (< (- (car p2) fuzz) (car pt2)) (< (car pt2) (+ (car p2) fuzz))) (and (< (- (car p2) fuzz) (car pt2)) (< (cadr pt2) (+ (cadr p2) fuzz))) (= flag2 0) (= flag1 1) ) (progn (setq p2z (caddr pt2)) ;(princ "\n p2z = ") ;(princ p2z) (setq flag2 1) ) ) (setq j (+ j 1)) ) (if (and (= flag1 1) (= flag2 1)) (progn (setq p1 (list (car p1) (cadr p1) p1z)) (setq p2 (list (car p2) (cadr p2) p2z)) (setq sloperatio (* 100 (/ (abs (- p1z p2z)) xydist))) ;(setq midpt (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2) (/ (+ (caddr p1) (caddr p2)) 2))) (if (> p1z p2z) ;(setq blkang (angle p1 p2)) (setq blkang (angle prevparam nextparam)) ;(setq blkang (angle p2 p1)) (setq blkang (angle nextparam prevparam)) ) ;(princ "\n sloperatio - ") ;(princ sloperatio) ;(princ "%") (setq slopeblock (vla-InsertBlock mspace (vlax-3d-point midpt) "-Slope-" 5 5 5 blkang)) (cond ((and (<= 0 blkang) (< blkang (/ pi 2))) ;(princ "a") ) ((and (<= (/ pi 2) blkang) (< blkang pi)) ;(princ "b") (setq blkang (- blkang pi)) ) ((and (<= pi blkang) (< blkang (* 1.5 pi))) ;(princ "c") (setq blkang (- blkang pi)) ) ((and (<= (* 1.5 pi) blkang) (< blkang pi)) ;(princ "d") ) ) (setq slopetextpt (polar midpt (+ blkang (* 0.5 pi)) 5)) (setq slopetext (entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 "-Label Between Geometry Points") (cons 67 0) (cons 100 "AcDbText") (cons 10 slopetextpt) (cons 11 slopetextpt) (cons 40 5) (cons 1 (strcat (rtos sloperatio 2 2) "%")) (cons 50 blkang) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 100 "AcDbText") (cons 73 0) ) ) ) (setq lengthtextpt (polar midpt (- blkang (* 0.5 pi)) 10)) (setq lengthtext (entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 "-Label Between Geometry Points") (cons 67 0) (cons 62 7) (cons 100 "AcDbText") (cons 10 lengthtextpt) (cons 11 lengthtextpt) (cons 40 5) (cons 1 (strcat (rtos xydist 2 2) "m")) (cons 50 blkang) (cons 41 1) (cons 51 0) (cons 7 "-Elevation-") (cons 71 0) (cons 72 1) (cons 100 "AcDbText") (cons 73 0) ) ) ) ) (progn ;(princ "\n there's no elevation point for this polyline") ) ) (setq i (+ i 1)) ) (princ) ) If the polyline bends sharply, the angle of the arrow and text may be strange. p.s - Is it correct to use the horizontal length rather than the inclined length? edit - angle problem in the gif has been corrected some
    5 points
  2. You probably all ready know this, but for others following this. If you use: (entget (car (entsel))) in the command line it will return the entity DXF code description for that (there are LISPs that do the same). Copy this and remove the '-1', '5' and '330' entries - this is the basis for entmake or entmakex (entmakex if you want to use the entity as in (setq MyNewEnt (entmakex (list ..... ))) ). If you entmake what you copy you will create a copy of the original entity. Anyway point being, if you are struggling with entmake, create a template entity as you want it, (entget.... ) it then you can modify the entmake code as required. Note that sometimes the order of the dxf codes is important too. I would ;; out parts so they can go back in again and check that it all still works OK. Sometimes what you make needs an attsync, redraw or regen to show the entity properly - blocks tend to like an attsync
    2 points
  3. probably not exactly what you want but should be relatively easy to modify to copy to all open drawings ;;; copy to drawing (defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all block objects in a list (foreach object (ss->ol ss) (setq object-list (cons object object-list))) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to wblock-dbx-container (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) (princ) ) (defun c:t1 ( / ss dwg ) (if (and (setq ss (ssget))(setq dwg (getfiled "Copy objects to :" (getvar 'dwgprefix) "dwg" 0)))(ctd ss dwg))(princ)) maybe : ;;; copy to all open doc (defun ctaod ( / ss ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) ;;; select objects (setq ss (ssget)) ; put all objects in a list (foreach object (ss->ol ss) (setq object-list (cons object object-list))) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ;;; copy objects to all open docs except active doc (vlax-for x (vla-get-documents (vlax-get-acad-object)) (if (not (eq x acDoc)) (progn (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace x)) (vla-save x) ) ) ) (princ) )
    2 points
  4. Speed and more speed, your home work is change the (command "point" pt) to a entmake function, just did 1590 text checks and with code change was like blink and you missed it ALL DONE. Took longer to select and press enter than convert. Maybe get a 2nd Hamster for the power wheel. Double the power.
    2 points
  5. Check all your command line's need to have space between variables and "quotes" ;bad (command _trim"" ssdl1 ssdl"" "f" c1 c2"") ;good (command _trim "" ssdl1 ssdl "" "f" c1 c2 "") space space space I counted about 5 lines that need space --edit Its also a good idea to add "_non" when feeding points into command line because they do snap to entity's that are close depending on zoom level. even if osnap is toggled off. (command "line" "_non" p1 "_non" p2 "") --edit -- edit just looked at the code a bit more and move all the creating of the blank selection sets outside of the loop you only need to do that once. and it might clear out the selection set.
    2 points
  6. Depends where you are in the world here in AUS its Ch 1234.45. Postal addresses in remote areas on roads are like 1092 meaning 10920 m from a start point.
    2 points
  7. (defun c:smadd (/ ss i addnum obj num otext utext ulist onum anum rnum rtext plusminus) (vl-load-com) (setq ss (ssget '((0 . "MTEXT")))) (setq i 0) (setq addnum (/ (getreal "\nhow much should I add: ") 100)) (while (< i (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss i))) (setq otext (vla-get-textstring obj)) (setq utext (LM:UnFormat otext t)) (setq ulist (Lm:str->lst utext "+")) (if (= (length ulist) 2) (progn (setq num (vl-string-subst "+" "." (rtos (+ addnum (atof (vl-string-subst "." "+" utext))) 2 2))) (setq rtext (vl-string-subst num utext otext)) (vla-put-textstring obj rtext) ) (progn ) ) (setq i (1+ i)) ) (princ) ) ;; 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 ) ) ) ) ah i understand. like this? If the total number is negative, how should it be expressed? For example, if -0.40 then -0+40? -0-60? Or Doesn't this work with negative numbers?
    2 points
  8. some edit of EnM4st3r's code. ah.. my mistake. Add and Subtract the last number of mtext with only one + or -. When it becomes negative, + changes to -. It does not work if there are two or more +'s. (defun c:smadd (/ ss i addnum obj num otext utext ulist onum anum rnum rtext plusminus) (vl-load-com) (setq ss (ssget '((0 . "MTEXT")))) (setq i 0) (setq addnum (getreal "\nhow much should I add: ")) (while (< i (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss i))) (setq otext (vla-get-textstring obj)) (setq utext (LM:UnFormat otext t)) (setq ulist (Lm:str->lst utext "+")) (if (= (length ulist) 2) (progn (setq onum (last ulist)) (setq anum (+ addnum (atof onum))) (if (> anum 0) (progn (setq anum (rtos anum 2 0)) (if (= (strlen anum) 1) (setq anum (strcat "0" anum)) ) (setq plusminus "+") ) (progn (if (= (strlen (rtos anum 2 0)) 2) (setq anum (strcat "0" (rtos (abs anum) 2 0))) (setq anum (rtos (abs anum) 2 0)) ) (setq plusminus "-") ) ) (setq rnum (strcat (car ulist) plusminus anum)) (setq rtext (vl-string-subst rnum utext otext)) (vla-put-textstring obj rtext) ) (progn (setq ulist (Lm:str->lst utext "-")) (if (= (length ulist) 2) (progn (setq onum (* -1 (atof (last ulist)))) (setq anum (+ addnum onum)) (if (> anum 0) (progn (setq anum (rtos anum 2 0)) (if (= (strlen anum) 1) (setq anum (strcat "0" anum)) ) (setq plusminus "+") ) (progn (if (= (strlen (rtos anum 2 0)) 2) (setq anum (strcat "0" (rtos (abs anum) 2 0))) (setq anum (rtos (abs anum) 2 0)) ) (setq plusminus "-") ) ) (setq rnum (strcat (car ulist) plusminus anum)) (setq rtext (vl-string-subst rnum utext otext)) (vla-put-textstring obj rtext) ) ) ) ) (setq i (1+ i)) ) (princ) ) ;; 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 ) ) ) )
    2 points
  9. also thought of saving the formatting in a list somehow, but didnt wanna dive into that
    2 points
  10. I'll be honest, I didn't understand what you were asking for originally Now I see this lisp I understand, and it has the gears in my mind turning with possibilities haha Knew you were in good hands.. Have a great weekend both
    2 points
  11. @pkenewellThis works perfectly. I can usually see how the programs work, but this work of genius, i can't get my head around... I have a couple of projects coming up where this would be used around 10 times each. Thank you my friend
    2 points
  12. @Sharper Actually I'm back from Holiday now so no problem . Hope your Holiday is going well. Just let me know how it works when you have time to look at it.
    2 points
  13. For Bricscad its "Print as PDF.pc3" but if you have a plot lisp can get which software is being used and set correct output. (if (wcmatch (getvar 'acadver) "*BricsCAD*" ) (setq printer "Print as PDF") (setq printer "Plot to PDF") ) Don't need Pc3 but I did copy "Publish to web PNG.pc3" from Acad to correct location but it returns not supported in my Bricscad. Not sure if later Versions have a PNG output.
    2 points
  14. Here, try this mhupp's mod... ;;----------------------------------------------------------------------------;; ;; PULL BLOCKS NAME TO UPDATE ATTRIBUTE (defun C:ATTBLKNAME () (C:ABN)) (defun C:ABN ( / effectivename ent Name Att ) (defun effectivename ( ent / blk rep ) (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**") (if (and (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk) ) ) ) '("AcDbBlockRepBTag") ) ) ) ) (setq rep (handent (cdr (assoc 1005 rep)))) ) (setq blk (cdr (assoc 2 (entget rep)))) ) ) blk ) (while (setq ent (car (entsel "\nSelect Block"))) ;gets an entity name using while will keep repeating if you keep selecting an entity (if (= (cdr (assoc 0 (entget ent))) "INSERT") ;test if its a block (progn (setq Name (effectivename ent)) ; pulls the name (setq Att (vlax-ename->vla-object (car (nentsel "Select Attribute Text to update")))) ; nentsel can get entity names inisde blocks (vla-put-textstring Att Name) ;update entity with name ) (progn ;if entity isn't a block will prompt user (prompt "\nNot a Block Pick again") (c:ABN) ;and start the comman over again. ) ) ) (princ) )
    2 points
  15. Noticed a type-o Steven (cons 78 (list "ANSI C (17.00 x 22.00 INCHES)" "ANSI B (22.00 x 17.00 INCHES)" )) to (cons 78 (list "ANSI C (17.00 x 22.00 INCHES)" "ANSI C (22.00 x 17.00 INCHES)" ))
    2 points
  16. @Mr Bojangles Here is a better example that includes a dialog box to select the file. You can change the command name and strings as stated in the comments to suit you needs. NOTE: in the path string, backslashes between folders have to be doubled "\\". Are these G-code files? I put the extension "gco" on the file dialog, but yours might use "g", "nc" or something else? ;; Change the command name to suit ;; Change the "C:\\Myfolder" path to whatever your files are located. ;; Change the "gco" (G code) file extension to whatever you are using (defun c:STRIPGC () (if (setq fil (getfiled "Select File to Strip" "C:\\Myfolder\\" "gco" 4)) (StripTextAtKwords fil "; Main Program Start" "; End Topcut") ) ) ;; Strips an ASCI text file of any lines between to keyword lines. (defun StripTextAtKwords (file kw1 kw2 / flg fp ln ls n) (if (and file (setq file (findfile file))) (progn (setq fp (open file "r") flg nil) (while (setq ln (read-line fp)) (if (= ln kw1)(setq flg T ls (cons ln ls))) (if (= ln kw2)(setq flg nil)) (if (not flg)(setq ls (cons ln ls))) ) (close fp) (if ls (progn (setq fp (open file "w") ls (reverse ls) n 0 ) (repeat (length ls) (write-line (nth n ls) fp) (setq n (1+ n)) ) (close fp) (princ "\nFile Updated.") ) ) ) (princ "\nFile Not found.") ) (princ) )
    2 points
  17. @Mr Bojangles It seems to work fine for me if the correct keywords are supplied. As long as the strings for kw1 and kw2 match the whole line: (defun c:test () (StripTextAtKwords "keywords.txt" "; Main Program Start" "; End Topcut") ) Results: #XZERO! = SD.USR.Allign.XPosActWPZP 1 #YZERO! = SD.USR.Allign.YPosActWPZP 1 IF (SD.ROTO.Batch=FALSE) THEN G1 G53 G153 G90 S90000 F30000 M3 G8 G17 G40 G47 G71 FFW(1) JKC(1) CLN(1) CLN(CollErr0) CLN(DLA4) M991 G1 Z50. F30000 ED1 1 ENDIF LP 8329025(0, 0, 0, 0) 1 IF (SD.ROTO.Batch=FALSE) THEN MIR(0) ROT(0) G153 G1 Z50 F30000 X[#XPLATE!] Y[#YPLATE!] M992 N10 ;***** END OF PROGRAM ***** 1 ENDIF M30 LPS 8329025 ; P1 X Offset ; P2 Y Offset ; P3 Rotation Angle ; P4 Operation to run in batch mode or all if 0 1 XOFFSET!=P1! : YOFFSET!=P2! : ROTANG!=P3! : OPERATION%=P4% 1 IF (SD.ROTO.Batch=TRUE) AND (OPERATION%=0) THEN 1 OPERATION%=SD.ROTO.BatchOperation 1 XOFFSET!=SD.ROTO.BatchXOffset 1 YOFFSET!=SD.ROTO.BatchYOffset 1 ROTANG!=SD.ROTO.BatchRotationOffset 1 ENDIF ; Plate TPH After Finishing 1 #DIEHEIGHT!=0.458 ; Programmed Z-Depth 1 #ZDEPTH!=-0.233 1 #ZZERO! = #DIEHEIGHT!+SD.ROTO.TableHeightAdjust 1 #XPLATE! = #XZERO!-XOFFSET!*COS(SD.USR.Allign.ResAngle)-YOFFSET!*SIN(SD.USR.Allign.ResAngle) 1 #YPLATE! = #YZERO!+YOFFSET!*COS(SD.USR.Allign.ResAngle)-XOFFSET!*SIN(SD.USR.Allign.ResAngle) 1 #RPLATE! = ROTANG!+SD.USR.Allign.ResAngle 1 PMT("PSI",154,1)=0 ; Main Program Start ; End Topcut 1 ENDIF 1 IF (OPERATION%=2) OR (OPERATION%=0) THEN ; Finishing 1 #FEEDRATE = 1417 LP TlChange LP Qualify(1.000,0.0,0.0) ; Qualify Sharp LP STP9025(521, 1, 90) LP TlChange LP Qualify(1.000,0.0,0.0) ; Qualify Sharp LP STP9025(521, 91, 180) ; End Finishing 1 ENDIF PEND ; End Subrouti
    2 points
  18. only real time is use entlast is in instances like @Steven P said or when i have to build a selection set after modifying/creating a bunch of stuff inside a lisp and don't want to prompt the user to select them again. (setq SS (ssadd)) ;how to create a blank selection set (setq LastEnt (entlast)) ;set right before you create objects. you want to either add to a selection set or track while in a lisp (while (setq LastEnt (entnext LastEnt)) ;after entities are created this will add them to a selection set. (ssadd EntLst SS) ;a blank selection set or existing selection set is needed. )
    2 points
  19. This is how I process a selection set. will generate a list of entity names for the selection (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ;code here will repeat for each each entity name in list ) A few years ago stumbled across what pkenewell posted to instead make a vla-object list (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) ;code here will repeat for each each vla-object name in list ) ent and obj don't need to be declared since they are only temp while in the foreach loop. -edit @dexus The (vl-remove-if 'listp is to remove the point or points used when making the selection set this isn't needed when ssget with "_X" option is used. Since a pick point isn't generated for those selection sets.
    2 points
  20. OP, have you tested the code I provided here : https://www.cadtutor.net/forum/topic/85374-why-would-entlast-not-be-getting-the-unioned-entity-in-this-code/?do=findComment&comment=640320 It seems that you avoid my inputs... It should do what should, as I also avoided (entlast)...
    2 points
  21. Yes, that's right. I try to avoid entlast if I can unless it is in the line straight after I have created an entity.
    2 points
  22. Nice idea! A small improvement though. You want to remove all list items from ssnamex before processing. That is in case the items are selected with a box or lasso, which is information that ssnamex returns as well. ;; Performs a function on all items in a selection set. (defun mapss (ss func) (mapcar func (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)) ) ) )
    2 points
  23. Yes, it's possible: (defun c:foo ( / pl pm) (and (setq pl (entsel "\nSelect polyline <exit>: ")) (progn (setq pm (vlax-curve-getParamAtPoint (car pl) (vlax-curve-getClosestPointTo (car pl) (trans (cadr pl) 1 0)))) (princ (list (vlax-curve-getpointatparam (car pl) (fix pm)) (vlax-curve-getpointatparam (car pl) (1+ (fix pm))) ) ) ) ) (princ) )
    2 points
  24. Above code tidied up and a slight change (defun c:ac1 ( / entname1 ent2name obj1 ent3name ) (setq ent1name (car (entsel "\nSelect region 1: "))) ;;Select region 1. Maybe use ss get with single selection & region filters (setq ent2name (car (entsel "\nSelect region 2: "))) ;;Select region 2. Maybe use ss get with single selection & region filters (setq ent3name (entmakex (entget ent1name))) ;;Copy region 1 (setq ent4name (entmakex (entget ent2name))) ;;copy region 2 (command "union" ent3name ent4name "") ;;Union Regions (setq obj3 (vlax-ename->vla-object ent3name)) ;;VLA- object name for region 1 copy (setq ent3area (rtos (vla-get-area obj3) 2 3)) ;;Area of 2 regions (redraw ent3name 3) ;;Highlight selected areas (getstring (strcat "\nArea: " ent3area ". Press Enter") ) (redraw ent3name 4) ;;Remove highlights (entdel ent3name) ;;Delete unioned area (princ) ;;Exit quietly )
    2 points
  25. I just found out that Vladimir Nesterovsky write a r-ss-foreach function back in 1997. https://vnestr.tripod.com/Revpline.lsp It's almost identical to my foreach-ss function, so not sure if we can call it "more modern commands" anymore .
    2 points
  26. Hey, @pkenewell and @mhupp You are legends! This works good enough that it clears the mess 80%. Tried my inverted method, with keeping anything that has "[a-zA-Z]{3,}" but somehow it got rid of a lot of text. Anyway 'im happy with this!
    2 points
  27. 2 points
  28. its kinda a backwards way of thinking but when we modify an entity we are essentially "deleting" the old one and "creating" a new one.
    2 points
  29. All you really need to do is convert the selection set over to vla-object and pull the textstring value. with vla-get-property this strips out the formatting (like you linked) usually don't use mtext so my bad. on the coding. noticed my unhide command was missing a * so it was only finding text and not mtext. updated the code to only process the selection set once since everything is being converted over to vla-object names at the start then adding them to a list if a number is found in the string. processing the list at the end. Probably be negligible in time but it ends up being more effectuate. This will find any mtext and text with a number in HideTextwNumbers.lsp
    2 points
  30. Another slight update the report at the end should give a list with 4 details per plot Paper Size, Orientation, LL Coord, UR Coord Limitation is going to be in the larger plot sizes if there is a polyline the same length as a smaller paper size with 4 verticies and closed at the end not sure if that will ever be an issue? (defun c:test ( / MySS MyPoly MyEnt MyPolyLength PtsList LL1 LL2 UR1 UR2 Orientation Paper BordersCoords) (setq BorderSizeList (list ;Perimeter : Paper Size Name (P) Paper Size name (L) (cons 39 (list "ANSI A (8.50 x 11.00 INCHES)" "ANSI A (11.00 x 8.50 INCHES)" )) (cons 56 (list "ANSI B (11.00 x 17.00 INCHES)" "ANSI B (17.00 x 11.00 INCHES)" )) (cons 78 (list "ANSI C (17.00 x 22.00 INCHES)" "ANSI C (22.00 x 17.00 INCHES)" )) (cons 112 (list "ANSI D (22.00 x 34.00 INCHES)" "ANSI D (22.00 x 34.00 INCHES)" )) )) (vl-load-com) (defun curvelength ( ent / )(vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))) ;; Lee Mac Suggestion (defun LM:MAssoc ( key lst / pair return ) ; Get 'key' values from dotted pair lists (while (setq pair (assoc key lst)) (setq return (cons (cdr pair) return) lst (cdr (member pair lst))) ) (reverse return) ) (setq MySS (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>")))) ; 4 or 5 points polylines (setq acount 0) ; A counter (while (< acount (sslength MySS)) ; Loop through Selection set MySS (setq MyPoly (ssname MySS acount)) ; nth item in MySS entity name (setq MyEnt (entget MyPoly)) ; nth item in MySS entity description (setq MyPolyLength (curvelength MyPoly)) ; Length of the polyline (setq fortytwomax 0) (foreach n (lm:MAssoc 42 MyEnt) (setq fortytwomax (max (abs n) fortytwomax))) ;Get maximum Polyline segment arc radius (if (and ; If: (or ; Poplyline is closed rectangle: (equal (assoc 10 MyEnt) (assoc 10 (reverse MyEnt)) 0.05 ) ; start / end point equal +/- 0.05 (equal (assoc 70 MyEnt) '(70 . 1)) ; 'closed' polyline ) ; endor (= 0 fortytwomax) ; Max segment radius 0: Straight lines only (or ; And polyline Length is border length (equal MyPolyLength 39 0.4) ; +/- 10% (equal MyPolyLength 56 0.6) ; +/- 10% (equal MyPolyLength 112 1.15) ; +/- 10% ) ) ; end and (progn (setq PtsList (lm:MAssoc 10 MyEnt)) ; Get list of polyline points (setq LL1 (car (car PtsList)))(setq LL2 (cadr (car PtsList))) ; Work out lower left / upper right coordinates (setq UR1 (car (car PtsList)))(setq UR2 (cadr (car PtsList))) (foreach n PtsList (setq LL1 (min (car n) LL1)) (setq LL2 (min (cadr n) LL2)) (setq UR1 (max (car n) UR1)) (setq UR2 (max (cadr n) UR2)) ) (if (< (- UR1 LL1) (- UR2 LL2)) (setq Orientation 0)(setq Orientation 1)) (setq Paper (nth Orientation (cdr (assoc MyPolyLength BorderSizeList)))) (if (< (- UR1 LL1) (- UR2 LL2)) (setq Orientation "P")(setq Orientation "L")) (setq BordersCoords (cons (list Paper Orientation (list LL1 LL2) (list UR1 UR2)) BordersCoords)) ; make list of all border coordiantes (redraw MyPoly 3) ; remove this line if happy with selection ) ;end progn ) ; end if (setq acount (+ acount 1)) ) (princ (length BordersCoords)) (princ " Borders Found. ") (getstring "\nHit Enter to remove highlights") ; remove this line if happy with selection (command "regen") ; remove this line if happy with selection (princ "\n Coordinates List: Ansi-Papersize Orientation (LL Cord) (UR Coord) ") (princ "\n")(princ BordersCoords) (princ) )
    2 points
  31. entlast should pick up the last thing modified or created in the drawing. please upload a sample drawing
    1 point
  32. Finally, i success to do my thing Need to share my code with you if someone else need the inspiration of doing something lookalike. ;; Version 0.1 ;; First version ;; Version 0.2 ;; Minor adjustments ;; Version 0.3 ;; Added Zoom -e ;; Tidy up zoom before we do anything else (command "._zoom" "e") (defun c:getFormattedDate () (setq today (rtos (getvar "CDATE") 2 0)) (setq year (substr today 3 2)) (setq month (substr today 5 2)) (setq day (substr today 7 2)) (strcat year "." month "." day) ) ;; Create the date string (setq currentDate (c:getFormattedDate)) (defun c:getFileNameNoExtension () (setq fullFileName (getvar "DWGNAME")) ; Get the full file name with extension (setq fileName (vl-filename-base fullFileName)) ; Remove path and file extension ; Search for the position of the first underscore and trim the file name from there (setq pos (vl-string-search "_" fileName)) (if pos (setq fileName (substr fileName 1 pos)) ; If underscore exists, take only the part before _ ) fileName ; Return the modified file name ) ;; Create the drawing number string (setq drawingName (c:getFileNameNoExtension)) (defun c:getBoxName () ;; Get the full file name with extension (setq fullFileName (getvar "DWGNAME")) ;; Remove path and file extension (setq fileName (vl-filename-base fullFileName)) ;; Search for the position of the last hyphen (setq lastHyphenPos nil) (setq i 1) (while (setq pos (vl-string-search "-" fileName i)) (setq lastHyphenPos pos) (setq i (+ pos 1)) ) ;; Search for the position of the first underscore (setq firstUnderscorePos (vl-string-search "_" fileName)) ;; Check if both positions are found (if (and lastHyphenPos firstUnderscorePos) ;; Extract the substring between the hyphen and the underscore (setq boxName (substr fileName (+ lastHyphenPos 2) (- firstUnderscorePos lastHyphenPos 1))) ;; If any position is not found, set boxName to an empty string (setq boxName "") ) ;; Add a dot between letters and numbers (setq modifiedBoxName "") (setq len (strlen boxName)) (setq i 1) (while (<= i len) (setq char (substr boxName i 1)) (if (and (> i 1) (or (and (vl-string-search char "0123456789") (vl-string-search (substr boxName (- i 1) 1) "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖabcdefghijklmnopqrstuvwxyzåäö")) (and (vl-string-search (substr boxName (- i 1) 1) "0123456789") (vl-string-search char "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖabcdefghijklmnopqrstuvwxyzåäö")))) (setq modifiedBoxName (strcat modifiedBoxName "." char)) (setq modifiedBoxName (strcat modifiedBoxName char)) ) (setq i (1+ i)) ) (setq boxName modifiedBoxName) ;; Add a plus sign in front of the result (setq boxName (strcat "+" boxName)) ;; Return the modified file name boxName ) ;; Create the boxName string (setq boxName (c:getBoxName)) (defun replace-swedish-chars (str) (setq replacements (list '("Å" . "\\u00C5") '("Ä" . "\\u00C4") '("Ö" . "\\u00D6") '("å" . "\\u00E5") '("ä" . "\\u00E4") '("ö" . "\\u00F6"))) (foreach pair replacements (setq str (vl-string-subst (cdr pair) (car pair) str))) str ) (defun UpdateBlock (NewTitles / ss obj atts att tag NewText) ; Get all block references with type "INSERT" and name "EPCB000" (setq ss (ssget "X" '((2 . "EPCB000")))) ; find the title block (here (1 . "INSERT") is not needed) (setq obj (vlax-ename->vla-object (ssname ss 0))) ; Get the title block as a VLA object (setq atts (vlax-invoke obj 'Getattributes)) ; List VLA tags / attribute names (foreach att atts ; Loop through tags / attributes (setq tag (vla-get-tagstring att)) ; Get the 'real' tag name (setq NewText (assoc tag NewTitles)) ; Find the tag as a dotted pair in the provided list (if NewText ; Check if the tag is in the provided list (progn (setq NewText (cdr NewText)) ; get the new tag value (vla-put-textstring att NewText) ; update the tag (princ (strcat "\nTag: " tag ", New value: " NewText)) ; Print updated tag and value to the command line ) ; end progn ) ; end if ) ; end foreach ) ; end UpdateBlock ;; SEARCH AND REPLACE (defun read-utf8-string (str) str ) (defun replace-g11-t11 (str) (if str (progn ;; Replace "G11" with "G12" (setq str (vl-string-subst "G12" "G11" str)) ;; Replace "T11" with "T12" (setq str (vl-string-subst "T12" "T11" str)) ) ) str ) (defun replace-11-12 (str) (if str (setq str (vl-string-subst ".12." ".11." str)) ) str ) (defun processAttributes () ;; Set the encoding system to UTF-8 (setq *coding-system* 'utf-8) ;; Get the block reference (setq ss (ssget "X" '((0 . "INSERT")(2 . "EPCB000")))) (setq obj (vlax-ename->vla-object (ssname ss 0))) (setq atts (vlax-invoke obj 'Getattributes)) ;; Initialize D5, D9, and D14 (setq D5 nil) (setq D9 nil) (setq D14 nil) ;; Loop through the attributes and get their values (while atts (setq att (car atts)) (setq atts (cdr atts)) (setq tag (vla-get-tagstring att)) (setq value (vla-get-textstring att)) (cond ((equal tag "D5") (setq D5 (read-utf8-string value))) ((equal tag "D9") (setq D9 (read-utf8-string value))) ((equal tag "D14") (setq D14 (read-utf8-string value))) ) ) ;; Replace values in D5, D9, and D14 (setq D5 (replace-g11-t11 D5)) (setq D9 (replace-g11-t11 D9)) (setq D14 (replace-11-12 D14)) ;; Return the processed values (list D5 D9 D14) ) ;; Process D5, D9, and D14 (setq processedValues (processAttributes)) (setq D5 (nth 0 processedValues)) (setq D9 (nth 1 processedValues)) (setq D14 (nth 2 processedValues)) ;; Create a list of block tags and their values, with Swedish characters replaced with UTF-8 codes (setq NewTitles (mapcar (lambda (pair) (cons (car pair) (replace-swedish-chars (cdr pair)))) (list (cons "C2" "KRAFTSTATION") ;; Facility '( "C10" . "506") ;; Project number '( "D6" . "TBY") ;; Drawn border frame left side (cons "D7" currentDate) ;; Date border frame left side '( "D8" . "AN") ;; Reviewed border frame left side '( "RITAD_AV" . "TBY") ;; Drawn border frame bottom '( "GRANSK_AV" . "J") ;; Reviewed by border frame bottom '( "GODK_AV" . "L") ;; Approved by border frame bottom (cons "GODK_DAT." currentDate) ;; Approved date border frame bottom (cons "D4" boxName) ;; Description row 1 border frame bottom (cons "D5" D5) ;; Description row 2 border frame bottom (cons "D9" D9) ;; Description row 3 border frame bottom (cons "D14" D14) ;; Function border frame bottom ;; '( "D12" . "") ;; Document type border frame bottom (cons "D13" drawingName) ;; Drawing number border frame bottom ;; '( "D10" . "") ;; Room border frame bottom '( "NOT1" . "") ;; Clear revision note 1 '( "ÄNDRING1" . "") ;; Clear revision note 1 '( "DATUM1" . "") ;; Clear revision note 1 '( "INF.1" . "") ;; Clear revision note 1 '( "GODK.1" . "") ;; Clear revision note 1 '( "NOT2" . "") ;; Clear revision note 2 '( "ÄNDRING2" . "") ;; Clear revision note 2 '( "DATUM2" . "") ;; Clear revision note 2 '( "INF.2" . "") ;; Clear revision note 2 '( "GODK.2" . "") ;; Clear revision note 2 '( "NOT3" . "") ;; Clear revision note 3 '( "ÄNDRING3" . "") ;; Clear revision note 3 '( "DATUM3" . "") ;; Clear revision note 3 '( "INF.3" . "") ;; Clear revision note 3 '( "GODK.3" . "") ;; Clear revision note 3 ) )) (UpdateBlock NewTitles) ; use this list in the 'UpdateBlock' function ;; Update file name in the text field. (defun replace-text-in-area-with-filename (startpoint endpoint) ;; Get the file name including extension (setq fullFileName (getvar "DWGNAME")) ;; Get all text objects within the specified area (setq ss (ssget "C" startpoint endpoint '((0 . "TEXT")))) (if ss (progn (setq count (sslength ss)) (setq i 0) ;; Loop through all selected text objects and replace their text with the file name (while (< i count) (setq obj (vlax-ename->vla-object (ssname ss i))) (vla-put-TextString obj fullFileName) (setq i (1+ i)) ) (princ (strcat "\nReplaced text in " (itoa count) " objects with the file name: " fullFileName)) ) (princ "\nNo text objects found within the specified area.") ) ) ;; Define the start and end point for the area (setq startpoint (list 0 277.5 0)) (setq endpoint (list 7 242.5 0)) ;; Call the function to replace the text with the file name (replace-text-in-area-with-filename startpoint endpoint) (princ) ; exit quietly
    1 point
  33. Try this untested mods and get sure that you modify the tag name to suit yours as commented in codes below. (defun c:Test (/ sel int ent att spc bkn ) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (or *bkn* (setq *bkn* "A")) (if (and (or (initget 6 "A B") (setq *bkn* (cond ((getkword (strcat "\nSpecify block name A / B < " *bkn* " > : "))) (*bkn*))) ) (or (tblsearch "BLOCK" (setq bkn (strcat (strcat "Block " *bkn*)))) (alert (strcat "Attributed Block < " bkn " > was not found in drawing <!>")) ) (princ "\nSelect Mtexts to be replaced with Attributed Block <ROOMTAG> :") (setq sel (ssget "_:L" '((0 . "MTEXT")))) ) (progn (defun unformatmtext (string / text str) ;; ASMI - sub-function ;; ;; Get string from Formatted Mtext string ;; (setq text "") (while (/= string "") (cond ((wcmatch (strcase (setq str (substr string 1 2))) "\\[\\{}`~]" ) (setq string (substr string 3) text (strcat text str) ) ) ((wcmatch (substr string 1 1) "[{}]") (setq string (substr string 2)) ) ((and (wcmatch (strcase (substr string 1 2)) "\\P") (/= (substr string 3 1) " ") ) (setq string (substr string 3) text (strcat text " ") ) ) ((wcmatch (strcase (substr string 1 2)) "\\[LOP]") (setq string (substr string 3)) ) ((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]") (setq string (substr string (+ 2 (vl-string-search ";" string)) ) ) ) ((wcmatch (strcase (substr string 1 2)) "\\S") (setq str (substr string 3 (- (vl-string-search ";" string) 2)) text (strcat text (vl-string-translate "#^\\" " " str)) string (substr string (+ 4 (strlen str))) ) (print str) ) (t (setq text (strcat text (substr string 1 1)) string (substr string 2) ) ) ) ) text ) (setq spc (vlax-get (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)) ) 'block ) ) (repeat (setq int (sslength sel)) (setq ent (ssname sel (setq int (1- int)))) (and (setq att (vla-insertblock spc (vlax-3d-point (cdr (assoc 10 (entget ent)))) bkn 1.0 1.0 1.0 0. ) ) (vl-some '(lambda (x) (if (eq (strcase (vla-get-tagstring x)) "ROOMNO") ;; change the tag name "ROOMNO" to suit yours (progn (vla-put-textstring x (unformatmtext (cdr (assoc 1 (entget ent)))) ) t ) ) ) (vlax-invoke att 'getattributes) ) (entdel ent) ) ) ) ) (princ) )(vl-load-com)
    1 point
  34. pkenewell nice idea very simple. Dahzee dont forget press F8 will force a H or V. F8 off / on etc.
    1 point
  35. @Highvoltage So - I started playing around with using regular expressions with windows scripting. Try the update attached. You might have to play around with the expression. It allows up to 2 letters, +, -, any length of numbers and a decimal. Seems to work OK in my tests but your texts might be different. HideTextwNumbers.lsp
    1 point
  36. Yes. I will see if i can clean it up later tonight.
    1 point
  37. I think part of the problem is, that the content of the text is formatted, and therefore it will find numbers in every single instance
    1 point
  38. Oops - yeah, mine wasn't actually working correctly either. My wcmatch pattern was wrong in a few ways. Unfortunately, I don't know wcmatch good enough to make it work, and I am not even sure (wcmatch) will do the job. I think regular expression is the way to go.
    1 point
  39. Absolutely perfect! Thank you very much for your help.
    1 point
  40. @Highvoltage Try this change to mhupp's code. It all has to do with correctly using (wcmatch). HideTextwNumbers.lsp
    1 point
  41. Steven P, As with all high quality code, the comments really help! Testing will commence this week. Your code submission will also go a long way to help in my continuing study of Visual LISP. My current, basic level of understanding of the LISP language (mostly AutoLISP) includes the purpose of the car, cadr, etc., in extracting values from lists. The Visual LISP will need much more attention from me. I feel that this is where yours and others code offerings based on a specific objective / request really help! Thanks, Clint
    1 point
  42. Try "*line" be aware that is lines polylines and 3dpolylines. Also "*line,arc" note the use of a comma "*line,arc,circle" "layer1,layer2,Layer3"
    1 point
  43. If you really must use JOIN, try the following approach: (command "_.selectsimilar" selset1 "") (initcommandversion) (command "_.join" (cadr (ssgetfirst)) "")
    1 point
  44. Give this a try. (defun c:Test (/ sel int ent att spc) ;; Tharwat - Date: 19.Jun.2017 ;; (if (and (or (tblsearch "BLOCK" "ROOMTAG") (alert "Attributed Block <ROOMTAG> is not found in drawing <!>") ) (princ "\nSelect Mtexts to be replaced with Attributed Block <ROOMTAG> :") (setq sel (ssget "_:L" '((0 . "MTEXT")))) ) (progn (defun unformatmtext (string / text str) ;; ASMI - sub-function ;; ;; Get string from Formatted Mtext string ;; (setq text "") (while (/= string "") (cond ((wcmatch (strcase (setq str (substr string 1 2))) "\\[\\{}`~]" ) (setq string (substr string 3) text (strcat text str) ) ) ((wcmatch (substr string 1 1) "[{}]") (setq string (substr string 2)) ) ((and (wcmatch (strcase (substr string 1 2)) "\\P") (/= (substr string 3 1) " ") ) (setq string (substr string 3) text (strcat text " ") ) ) ((wcmatch (strcase (substr string 1 2)) "\\[LOP]") (setq string (substr string 3)) ) ((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]") (setq string (substr string (+ 2 (vl-string-search ";" string)) ) ) ) ((wcmatch (strcase (substr string 1 2)) "\\S") (setq str (substr string 3 (- (vl-string-search ";" string) 2)) text (strcat text (vl-string-translate "#^\\" " " str)) string (substr string (+ 4 (strlen str))) ) (print str) ) (t (setq text (strcat text (substr string 1 1)) string (substr string 2) ) ) ) ) text ) (setq spc (vlax-get (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)) ) 'block ) ) (repeat (setq int (sslength sel)) (setq ent (ssname sel (setq int (1- int)))) (and (setq att (vla-insertblock spc (vlax-3d-point (cdr (assoc 10 (entget ent)))) "ROOMTAG" 1.0 1.0 1.0 0. ) ) (vl-some '(lambda (x) (if (eq (strcase (vla-get-tagstring x)) "ROOMNO") (progn (vla-put-textstring x (unformatmtext (cdr (assoc 1 (entget ent)))) ) t ) ) ) (vlax-invoke att 'getattributes) ) (entdel ent) ) ) ) ) (princ) )(vl-load-com)
    1 point
  45. Alright, here is what I am willing to do. I will leave my CAD computer on with CADTutor on my browser and AutoCAD up and running with the Oleson Village project drawing open. If you run into a real problem, and it is not later than 7:45 PM (our time) you can call me. After that time I am not available and my computer will be shut down for the evening. My day starts way too early to spend half the night walking you through the remainder of the project. Good luck. Time now is 7:00 PM.
    1 point
  46. I think if I actually knew how to put a benchmark on the model, It would make life easier. Just a guess. I know it seems like I haven't read anything, but I have. Everything seems chinese to me. You can read how to ride a bike for 5 years, but you don't know how to do it until you actually try it. I have put in serious hours just on the first few pages. Have you actually done this project?
    1 point
  47. Tests are done, now i have to complete the project to finish the course. The timing conflicts with my tuition reimbursement. My company is a multi-billion dollar company that just keeps taking from customers and their employees. I am in the very beginning. Table 2. I think i skipped the plot size, and a couple of other things. I hope it works out. I didn't even figure out the scaling. Anyways, i am new to this and i am a truly hands on learner, so if there are no video lessons then i am screwed. Lol
    1 point
  48. You live in Norwalk, CT? Would you be available for hire for a day? I just want to get the project done. I don't really have the time because my company has put strict deadlines on completing my course. Also, AUTOcad is not required for the job I am applying for. In the meantime, I will give it a shot, but I have less than two weeks to complete this project. All my other classes are pretty much finished. Thanks.
    1 point
  49. I guess CAB wouldn't mind... Attached. As I said, this is CAB's routine and I take no credit for it. The original thread is here: http://www.theswamp.org/index.php?topic=8855.0 PageSetups_CAB_06.LSP
    1 point
×
×
  • Create New...