All Activity
- Past hour
-
MultiPLine (MPL) — polyline-based MLINE replacement with per-line layers, presets, and auto-sync [Free + Pro]
SkillAmplifier replied to SkillAmplifier's topic in AutoLISP, Visual LISP & DCL
@BIGAL — the Pipe offsets approach is practical — hardcoded OD values per size as named commands (P300, P450 etc) is exactly the kind of thing that saves time on repetitive civil work. Applies the offset and switches to Divide linetype in one shot. Clean for a site-specific workflow. The Fillet offset circle reactor is a nice trick — using :vlr-unknowncommand to intercept custom prefixed strings like F100 or O234 is a different approach than what I went with. Avoids the willstart/ended pair entirely by hooking into unrecognised input instead. Here's the core VLR setup from the Pro version for comparison: (vlr-command-reactor nil '((:vlr-commandWillStart . mpla-on-cmd-willstart) (:vlr-commandEnded . mpla-on-cmd-ended) (:vlr-commandCancelled . mpla-on-cmd-cancel) (:vlr-commandFailed . mpla-on-cmd-cancel)) ) The willstart handler snapshots vertex lists and widths of all MPL masters into a global cache (*mpla-master-cache*). The ended handler diffs and rebuilds only the groups that changed. Went this route to watch standard commands passively without requiring any special input syntax. Happy to share more if useful. - Today
-
Good to know about "Gstarcad 2023" some of the other CAD programs do have little hidden issues that pop up now and then. But to Cadtutor's credit it is not a one platform forum.
-
MultiPLine (MPL) — polyline-based MLINE replacement with per-line layers, presets, and auto-sync [Free + Pro]
BIGAL replied to SkillAmplifier's topic in AutoLISP, Visual LISP & DCL
Taking your example video this is convert a p/line to a drainage pipe written for civil road works, with most common AUS sizes. Needs linetype Equal the length of dashed is set to 2.4 which is a length of a concrete pipe. Handy for civil works. It is not dynamic. *EQUAL,_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ A,1.0,-1.0 Pipe offsets.lsp If you post here a VLR function can test. Fillet offset circle.lsp Have a look at "Fillet offset circle" uses reactors. - Yesterday
-
kmmwlton32 joined the community
-
hilotc joined the community
-
I doubt if IT would allow that either, I have it at home so might see how that would work out. I believe Ghostscript's txtwrite is improved and should be capable as well, as noted an OCR is needed for images, Tesseract OCR — The World's Best Open Source OCR Engine. There may still be errors in the conversions. I know Adobe Acrobat has issues at times, I haven't used it in a few months though.
-
You have multiple locations using a redundant entget. (vlax-ename->vla-object (cdr (car (entget e1))) == (vlax-ename->vla-object e1)
-
Another way to get the text from a pdf is the AI option 'OCR text & table from Microsoft PC manager, normally just available in the US store. But if you have VPN or are a really good singer (Queen : Oh...yes , I'm the great pretender lalala.. applause , oh thank you , you're so kind) you should be able to get it. Open pdf , use button et voila... but its still manual labor
-
In fact, I haven't updated my profile: I no longer use the 2012 version but I use Gstarcad 2023 and sometimes Autocad LT 2026 (subject of the question). I apologize to all of you for not having read the new posts anymore.
-
Tried this out some yesterday, this will be useful for sure! The things we have to do to bypass security features that don't work. I remember in high school a few teachers would tell the kids that didn't make passing grades that the world needs ditch diggers, too. Now they probably say the world needs IT techs. Some of the things they do defy any sort of normal thought processes. I received a call last week, one of the main people that use my drawings called and stated they couldn't open drawings after IT installed a new computer. You guessed it, no AutoCAD. A normal person should see what was on the old computer that was necessary and needs to move to the new computer. At least they installed the software for the waterjet, plasma cutter, etc.
-
This may help you set up for checking your LISPs Graebert LISP Extension[FLISP] - ARES Commander Partner Documentation - Confluence
-
MultiPLine (MPL) — polyline-based MLINE replacement with per-line layers, presets, and auto-sync [Free + Pro]
SkillAmplifier replied to SkillAmplifier's topic in AutoLISP, Visual LISP & DCL
Thanks both for the honest feedback — exactly what I was hoping for. @pkenewell — appreciate the link, I'm aware of Lee Mac's MPLine and have a lot of respect for his work. His implementation is elegant and handles the core offset drawing well. MultiPLine goes in a different direction: DCL-based configuration dialog, per-line layer assignment, named presets that persist across drawings, and the Pro version adds a command reactor for auto-sync. Different scope rather than a direct replacement for what he built. Worth knowing about either way so thanks for flagging it. @BIGAL — fair points across the board. BricsCAD: honestly didn't design for it and can't make promises there. The reactor implementation in Pro leans on AutoCAD-specific VLR functions. Lite might load fine in BricsCAD but I haven't tested it — if any BricsCAD users try it I'd be curious to hear the result. On the "why pay" question: fair challenge. The free Lite version covers the core workflow for most users. The Pro is aimed at teams and daily-driver users who want auto-sync and a preset library they can share across a team. Whether that's worth $29 is genuinely up to the buyer — I'm not trying to oversell it. The package suggestion is actually something I've been thinking about. MultiPLine is my first commercial release but I have other tools in progress. A bundle makes more sense as a value proposition and I'll keep that in mind for when there's more to package together. One more thing — I've added the full .lsp source to the Lite download on Gumroad. Free to inspect, modify for personal use, and learn from. Thanks again for taking the time — this kind of feedback from experienced users is more useful than any marketing. Zlatislav -
WangWei joined the community
-
I know where your coming from where I worked last some 1000 pc's, we were lucky and had a good relationship with IT and could explain why we wanted something and most times they would go away and think about it, but approve and install, they would come to me to do the CAD installs, with the IT guy with me for user permissions. Each new PC was a "Hope it works" as they came preinstalled with corporate software.
-
MultiPLine (MPL) — polyline-based MLINE replacement with per-line layers, presets, and auto-sync [Free + Pro]
BIGAL replied to SkillAmplifier's topic in AutoLISP, Visual LISP & DCL
Just a couple of comments have this, type 2,4,-3,-4 and so on, draws multiple plines, as many as you type in one go.. Have a drag line over existing multi offsets and get all offsets and layers, so can make another pline without user input. Also what about Bricscad users ? Plenty of us here as well as other software. Oh yeah look at this image you draw a "WALL" that is multiple lines and on correct layers, predefined layers that are named in a txt file, so match what a user wants without editing code, won't go into how we made that work other than variable = layer name. Not sure that the task really warrants a VLX and a cost when there is software out there for the task and its free. I know from experience trying to sell software is extremely hard, as per draw house program some 130 lisps. Do you have something similar to the attached DOCX, showing what you have as say a package, most programs are free and open source some have a cost as need to be customised for clients. There is more scope for users to buy a package rather than just one program. Lisp files DEC 2025.docx -
mhupp started following ARES Commander LISP not Working
-
I try to use foreach when possessing list. (if (setq s (ssget (list '(0 . "INSERT")))) (progn (command "-VIEW" "S" tempViewName) (setq chk T i 0 n (sslength s)) (while (< i n) (setq e (ssname s i) x (cdr (assoc 2 (entget e))) i (1+ i) ) ... (command "_zoom" "_object" (cdr (car (entget e))) "") (setq 1P (car (LM:boundingbox (vlax-ename->vla-object (cdr (car (entget e))))))) (setq 2P (nth 2 (LM:boundingbox (vlax-ename->vla-object (cdr (car (entget e))))))) turns into (if (setq s (ssget (list '(0 . "INSERT")))) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (command "-VIEW" "S" tempViewName) (setq Name (cdr (assoc 2 (entget ent))) chk T ) (command "_zoom" "_object" ent "") (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt) (setq 1P (vlax-safearray->list minpt) 2P (vlax-safearray->list maxpt)) repeat foreach for s1 with point list Should be (cadr 1P) not (car (cdr 1P))
- Last week
-
Steven P started following ARES Commander LISP not Working
-
As SWL says, what is the error? Where does it fail? That would help identify a problem.
-
Nice job!
-
pkenewell started following MultiPLine (MPL) — polyline-based MLINE replacement with per-line layers, presets, and auto-sync [Free + Pro]
-
MultiPLine (MPL) — polyline-based MLINE replacement with per-line layers, presets, and auto-sync [Free + Pro]
pkenewell replied to SkillAmplifier's topic in AutoLISP, Visual LISP & DCL
https://www.lee-mac.com/mpline.html FYI - not to detract from your work, which I'm sure was extensive. -
KJH joined the community
-
paolademarcus joined the community
-
Before I used this : (defun GetFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application")) (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path)) (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) f) (defun wait (sec / stop)(setq stop (+ (getvar "DATE") (/ sec 86400.0)))(while (> stop (getvar "DATE")))) (defun findstring ( / a b c d e) (setq a (GetFolder "Select folder for string search")) (setq b (getstring "\nEnter string to search for : " T)) (setq c (getstring "\nFile extension (lsp) : ")) (if (eq c "") (setq c "lsp")) (setq d (strcat a "\\result.txt")) (setq e (strcat "findstr /i /s \"" b "\" " a "\\*." c " > " d)) (command "shell" e) (gc)(gc) ;;; natural delay for system to clear cache and write file to disk (alert "search completed") (startapp "notepad" d) (princ) ) (defun c:dfs ()(findstring)) (defun c:t1 ()(findstring)(princ)) This code only works for text based files. Have updated code in my first post with Excel support. Valid extensions are now lsp , txt , dwg , xls and xlsx I have a license for able2extract on my home computer and also written something that uses pdfattach and import for readable pdf's. Though I can take that route, it's not like shoot & forget , often more than one step is needed. But it is what it is... most pdf's I get are pretty poor quality , some by accident and some not because a 3rd party wants you as a returning client if you know what I mean.
-
mhupp started following Quick String Search
-
If the text is Searchable in the PDF. Windows Explorer will work. if the PDF is just an image then it wont work and have to use Adobe's OCR to convert them to be searchable. -Edit Tho not 100% some stuff come in weird like fractions or text between white space and pictures.
-
Yeah , well , I'm afraid to tempt 'the Gods' how much worse it can get haha. Big reorganization on its way and we hope things can only get better , but that's maybe tempting fate In the mean while got it working (I think) for excel workbooks too , but gonna have to post that later when I get home tonight. Clippy (the AI) told me without external programs like Adobe or pdf2text , its very unlikely I'm gonna be able to directly retrieve strings from a pdf. Since I cant install any software other than provided by the company that's not gonna happen. Only way would be pdfimport and pdfshx but that would defeat the purpose of this appie.
-
dexus started following Quick String Search
-
Nice work IT! They got you to spend hours trying to circumvent the limitations they forced upon their employees just to make it workable.
-
I have moved your post to a new thread ARES Commander LISP not Working in the AutoLISP, Visual LISP & DCL Forum. Please use Code Tags for posted code in the future. (<> in the editor toolbar) Where did you get the LISP and what does it do? Do other LISPs run in your Ares Commander? What does not work? Do you have the Visual Studio Code and the Graebert LISP Extension for troubleshooting the LISP?
-
Have they locked Powershell also ? I use it at times. Converting the lisp code to .net would speed up searching the txt & lsp files, in lisp directory I have 1500+ lsp files. But chances are your admin has that locked.
-
Dynamic block pipes and fittings on existing line like revit
nod684 replied to M07's topic in AutoLISP, Visual LISP & DCL
eh sorry i forgot to put the link -
I also used to use theDOS thing , but its not nearly as sexy : (sorry , <> has been disabled by my work , file upload as well and if I try to use a bat file admin locks me down) Will post tonight
-
khrys joined the community
-
can anyone help me with this, this lisp work in autocad perfectly but i want to use this to ares but it doesn't work (defun c:KKK ( / TBName TBTemp s flag ctr SheetSize chk PrjName LaynName i n e x 1p 2p o1p o2p y1p y2p s1 i1 n1 e1 x1 s2 i2 n2 e2 x2 Psize Size file tempViewName DwgTitle ) (setvar "CMDECHO" 0) (setq TBName "Title Block_R2.R") (setq TBTemp "FT NEW TEMPLATE 2.0") (setq s nil) (setq flag 1) (setq ctr 1) (setq SheetSize nil) (setq chk nil) (setq LaynName (car (layoutlist))) (setq DwgTitle "Title_info") (setq tempViewName "_TEMP_ORIGINAL_VIEW") (if (setq s (ssget (list '(0 . "INSERT") ))) (progn (command "-VIEW" "S" tempViewName) (setq chk T) (setq i 0 n (sslength s) ) (while (< i n) (setq e (ssname s i) x (cdr (assoc 2 (entget e))) i (1+ i) ) ;(print x) (if (= (LM:name->effectivename x) TBName ) (progn (command "_zoom" "_object" (cdr(car(entget e))) "") (setq 1P (car(LM:boundingbox (vlax-ename->vla-object (cdr(car(entget e))))))) (setq 2P (nth 2 (LM:boundingbox (vlax-ename->vla-object (cdr(car(entget e))))))) (setq o1P 1P) (setq o2P 2P) (setq y1p (strcat (rtos (car 1P) 2 0) "," (rtos (car (cdr 2P)) 2 0))) (setq y2p y1p) (setq s1 (ssget "W" 1P 2P (list '(0 . "INSERT") ))) (setq i1 0 n1 (sslength s1) ) (while (< i1 n1) (setq e1 (ssname s1 i1) x1 (cdr (assoc 2 (entget e1))) i1 (1+ i1) ) (if (= (cdr (assoc 0 (entget e1))) "INSERT") (cond ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e1))))) "NESTED") (setq SheetSize (LM:assoc++ (setq Size (strcat (LM:getattributevalue (cdr (car(entget e1))) "SHEET_WIDTH") "X" (LM:getattributevalue (cdr (car(entget e1))) "SHEET_HEIGHT"))) SheetSize)) (setq PSize (assoc Size SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e1))))) "SINGLE PANEL") (setq s2 (ssget "W" (subst (- (car 1p) 450) (car 1p) 1p) 2P (list '(0 . "INSERT") ))) (setq i2 0 n2 (sslength s2) ) (while (< i2 n2) (setq e2 (ssname s2 i2) x2 (cdr (assoc 0 (entget e2))) i2 (1+ i2) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "NestedPanelTitle") (setq Psize (LM:getattributevalue (cdr (car(entget e2))) "PANELNAME")) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "AWC") (LM:setattributevalue e2 "RUN_PROGRAM" "-") ) ) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e1))))) "NESTED (OFFCUT)") (setq SheetSize (LM:assoc++ "OFFCUT" SheetSize)) (setq PSize (assoc "OFFCUT" SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) ) ((= x1 DwgTitle) (setq PrjName (vl-string-trim "Model" (LM:getattributevalue e1 "PROGRAM_NAME:"))) ) );cond );if );while );progn );if ) (if (= PSIZE nil) (setq flag 0) (progn (CreateScript) ) ) ) (progn (setq flag 0) (setq ctr 0) ) );if (princ) (while (= flag 1) (while (= ctr 1) (setq 1P (list (car 1P)(- (car(cdr 1P)) 4127 ))) (setq 2P (list (car 2P)(- (car(cdr 2P)) 4127 ))) (setq y1p (strcat (rtos (car 1P) 2 0) "," (rtos (car (cdr 2P)) 2 0))) (command "._zoom" "non" 1P "non" 2P) (if (setq s (ssget "_W" 1P 2P)) (progn (setq i 0 n (sslength s) ) (while (< i n) (setq e (ssname s i) x (cdr (assoc 0 (entget e))) i (1+ i) ) (if (= x "INSERT") (cond ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "NESTED") (setq SheetSize (LM:assoc++ (setq Size (strcat (LM:getattributevalue (cdr (car(entget e))) "SHEET_WIDTH") "X" (LM:getattributevalue (cdr (car(entget e))) "SHEET_HEIGHT"))) SheetSize)) (setq PSize (assoc Size SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) (WriteScript) (setq ctr 1) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "SINGLE PANEL") (setq s2 (ssget "W" (subst (- (car 1p) 450) (car 1p) 1p) 2P (list '(0 . "INSERT") ))) (setq i2 0 n2 (sslength s2) ) (while (< i2 n2) (setq e2 (ssname s2 i2) x2 (cdr (assoc 0 (entget e2))) i2 (1+ i2) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "NestedPanelTitle") (setq Psize (LM:getattributevalue (cdr (car(entget e2))) "PANELNAME")) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "AWC") (LM:setattributevalue e2 "RUN_PROGRAM" "-") ) ) (WriteScript) (setq ctr 1) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "NESTED (OFFCUT)") (setq SheetSize (LM:assoc++ "OFFCUT" SheetSize)) (setq PSize (assoc "OFFCUT" SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) (WriteScript) (setq ctr 1) ) );cond ) );WHILE );PROGN );IF (if (= s nil) (setq ctr 0)) (princ) );while (setq 1P (list (+ (car o1P) 6830 )(car(cdr o1P)))) (setq 2P (list (+ (car o2P) 6830 )(car(cdr o2P)))) (setq y1p (strcat (rtos (car 1P) 2 0) "," (rtos (car (cdr 2P)) 2 0))) (setq o1P 1P) (setq o2P 2P) (command "_zoom" 1P 2P) (if (setq s (ssget "_W" 1P 2P)) (progn (setq i 0 n (sslength s) ) (while (< i n) (setq e (ssname s i) x (cdr (assoc 0 (entget e))) i (1+ i) ) (if (= x "INSERT") (cond ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "NESTED") (setq SheetSize (LM:assoc++ (setq Size (strcat (LM:getattributevalue (cdr (car(entget e))) "SHEET_WIDTH") "X" (LM:getattributevalue (cdr (car(entget e))) "SHEET_HEIGHT"))) SheetSize)) (setq PSize (assoc Size SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) (WriteNextScript) (setq ctr 1) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "SINGLE PANEL") (setq s2 (ssget "W" (subst (- (car 1p) 450) (car 1p) 1p) 2P (list '(0 . "INSERT") ))) (setq i2 0 n2 (sslength s2) ) (while (< i2 n2) (setq e2 (ssname s2 i2) x2 (cdr (assoc 0 (entget e2))) i2 (1+ i2) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "NestedPanelTitle") (setq Psize (LM:getattributevalue (cdr (car(entget e2))) "PANELNAME")) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "AWC") (LM:setattributevalue e2 "RUN_PROGRAM" "-") ) ) (WriteNextScript) (setq ctr 1) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "NESTED (OFFCUT)") (setq SheetSize (LM:assoc++ "OFFCUT" SheetSize)) (setq PSize (assoc "OFFCUT" SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) (WriteNextScript) (setq ctr 1) ) );cond ) );WHILE );PROGN );IF (if (= nil s)(setq flag 0)) );while (DelAllLayout) (if (= chk nil) (princ "\nInvalid Object") (progn (setq file (open (strcat (getvar "dwgprefix") "CreateScript.scr") "A")) (write-line "LockAllVp" file) (write-line "MODEL" file) (write-line (strcat "-VIEW\tR " tempViewName "\n ") file) (write-line (strcat "-VIEW\tD " tempViewName "\n ") file) (write-line "REGENALL" file) (close file) (command "_.Layout" "Set" (car (layoutlist))) (command "_.script" (strcat (getvar "dwgprefix") "CreateScript.scr")) ) ) (setvar "CMDECHO" 1) (princ) );defun ;========================================================================= (defun LM:name->effectivename ( blk / rep ) (if (and (wcmatch blk "`**") (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag") ) ) ) ) (setq rep (handent (cdr (assoc 1005 rep)))) ) (cdr (assoc 2 (entget rep))) blk ) ) ;========================================================================= (defun LM:boundingbox ( obj / a b lst ) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b)))) (setq lst (mapcar 'vlax-safearray->list (list a b))) ) (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a)) '( (caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr) ) ) ) ) ;========================================================================= (defun LM:getattributevalue ( blk tag / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (cdr (assoc 1 (reverse enx))) (LM:getattributevalue blk tag) ) ) ) ;========================================================================= (defun LM:setattributevalue ( blk tag val / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx)) (progn (entupd blk) val ) ) (LM:setattributevalue blk tag val) ) ) ) ;========================================================================= (defun LM:effectivename ( obj ) (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name ) ) ) ;========================================================================= (defun LM:assoc++ ( key lst / itm ) (if (setq itm (assoc key lst)) (subst (cons key (1+ (cdr itm))) itm lst) (cons (cons key 1) lst) ) ) ;========================================================================= (defun CreateScript () (setq file (open (strcat (getvar "dwgprefix") "CreateScript.scr") "W")) (write-line (strcat ".mview\tL\tOFF\tALL \nLAYOUT\tR\t" LaynName "\t" "-") file) (write-line (strcat "LAYOUT\tR\t" "-" "\t" PSize) file) (close file) (setq LaynName PSize) (crText (mapcar '+ '(150 2200) (list (car 1p) (cadr 1p))) 75 (strcat PrjName laynname)) ) ;========================================================================= (defun WriteScript () (setq file (open (strcat (getvar "dwgprefix") "CreateScript.scr") "A")) (write-line (strcat "LAYOUT\tC\t" LaynName "\t" PSize "\tLAYOUT\tS\t" PSize "\tGoLast\tMspace\t-pan\t" y1p "\t" y2p "\tPspace") file) (close file) (setq LaynName PSize) (setq y2p y1p) (crText (mapcar '+ '(150 2200) (list (car 1p) (cadr 1p))) 75 (strcat PrjName laynname)) ) ;========================================================================= (defun WriteNextScript () (setq file (open (strcat (getvar "dwgprefix") "CreateScript.scr") "A")) (write-line (strcat "LAYOUT\tC\t" LaynName "\t" PSize "\tLAYOUT\tS\t" PSize "\tGoLast\tMspace\t-pan\t" y1p "\t" y2p "\tPspace") file) (close file) (setq LaynName PSize) (setq y2p y1p) (crText (mapcar '+ '(150 2200) (list (car 1p) (cadr 1p))) 75 (strcat PrjName laynname)) ) ;========================================================================= (defun fixitoa ( #i #n / s ) (setq s (itoa #i))(while (> #n (strlen s))(setq s (strcat "0" s))) s) ;========================================================================= (defun LM:getvisibilitystate ( blk / vis ) (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) ;========================================================================= (defun LM:getvisibilityparametername ( blk / vis ) (if (and (vlax-property-available-p blk 'effectivename) (setq blk (vla-item (vla-get-blocks (vla-get-document blk)) (vla-get-effectivename blk) ) ) (= :vlax-true (vla-get-isdynamicblock blk)) (= :vlax-true (vla-get-hasextensiondictionary blk)) (setq vis (vl-some '(lambda ( pair ) (if (and (= 360 (car pair)) (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair))))) ) (cdr pair) ) ) (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary blk)) "ACAD_ENHANCEDBLOCK" ) ) ) ) (cdr (assoc 301 (entget vis))) ) ) ;========================================================================= (defun LM:getdynpropvalue ( blk prp ) (setq prp (strcase prp)) (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties) ) ) ;========================================================================= (defun DelAllLayout ( / ll) (command "_.Layout" "Set" (car (getLayoutOrderList))) (while (/= 0 (setq ll (- (setq ll (length (getLayoutOrderList))) 1 ))) (progn (if (> ll 0) (command "_-LAYOUT" "DELETE" (nth ll (getLayoutOrderList))) ) );progn );while (command "Model") ) ;========================================================================= (defun getLayoutOrderList( / lst mklist mappend flatten) (defun mklist (x) (if (listp x) x (list x))) (defun mappend (fn lst)(apply 'append (mapcar fn lst))) (defun flatten (expr)(mappend 'mklist expr)) (vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (setq lst (cons (list (vla-get-taborder lay)(vla-get-name lay)) lst)) ) (cdr(flatten(mapcar 'cdr (vl-sort lst '(lambda (a b) (< (car a)(car b))))))) ) ;========================================================================= (defun c:GoLast (/ l) (if (and (< 2 (vla-get-count (setq l (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) ) ) (eq 0 (getvar 'TILEMODE)) ) (vla-put-taborder (vla-item l (getvar 'CTAB)) (1- (vla-get-count l)) ) (princ "\n ** Command is not allowed in Model Space **") ) (princ) ) ;========================================================================= (defun C:LockAllVp ( / i oldlo oldcmde) (setq oldcmde (getvar "CMDECHO")) (setvar "CMDECHO" 0) (setq oldlo (getvar "CTAB")) ;cannot lock model ; (setvar "CTAB" "Model") ;all layouts (foreach i (layoutlist) (progn (setvar "CTAB" i) (command "_-VPORTS" "_Lock" "_on" "_all" "") );progn ) (setvar "CTAB" oldlo) (setvar "CMDECHO" oldcmde) (princ "\nAll viewports locked.") (princ) ) ;========================================================================= (defun crText ( ins hgt str / ent ) (entmake (list '(000 . "TEXT") '(100 . "AcDbText") '(7 . "TEXT") '(8 . "Defpoints") (cons 010 ins) (cons 040 hgt) (cons 001 str) ) ) ) ;========================================================================= (defun *error* (msg) (if (not (wcmatch msg "quit/exit abort,function canceled")) (princ (strcat "\nError: " msg)) ; Display message for actual errors ) (setvar "CMDECHO" 1) ; Ensure settings are reset (princ) ; Quiet exit ) ;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- (princ (strcat "\n:: Version 1.1 | \\U+00A9 FT ::" "\n:: This Progam also works with Single Panel ::" "\n:: \"CRL\" to Create Layout ::" ) ) (princ)
