Leaderboard

updated the lisp with the following - entmake for point and text (faster) - got rid of nth its slower then then car cadr caddr last - updated while to combined lines of code Also I don't think the easting and northing are in the right order but left it like the lisp had it. so if your points are in the wrong spot maybe update to below (setq POINT (list (cadr POINT_LINE) ;Get x (caddr POINT_LINE) ;Get y (last POINT_LINE) ;Get z ) ) ; POINTPLT is a simple AutoLSIP program that will plot a coordinate points file ; in AutoCAD. To run POINTPLT, load POINTPLT.LSP as you would any normal ; AutoLISP file (see AutoCAD Reference Manual), type "POINTPLT" and press ; [Enter]. POINTPLT will first prompt you for an input coordinate filename. ; You must enter a vaild DOS filename at this point. The input coordinate file ; must be in the following format: ; ; POINT NO. NORTHING(y) EASTING(x) ELEVATION(z) ; ; A sample input coordinate file (SAMPLE.DAT) is included with POINTPLT. ; ; POINTPLT uses the default (current) text style and layer. However, the ; current text style must have a defined height (height must not be "0"). ; ; If you have any questions or comments concerning POINTS, I may be reached ; via THE SPECTRUM BBS þ (501) 521-5639 ; ;------------------------------------------------------------------------------- ; * ERROR Trapping * ; (defun *ERROR* () (eop) ) ;------------------------------------------------------------------------------- ; * End of program * ; (defun EOP () (setvar "CMDECHO" POINTSPLT_CE) (princ) ) ;------------------------------------------------------------------------------- ; * Main Program * (defun C:POINTPLT (/ IN_FILE POINT_LINE POINT_NO POINT) (setq POINTSPLT_CE (getvar "CMDECHO")) (setvar "CMDECHO" 0) ;Turn "Command Echo" off (prompt "\n\nP O I N T P L T v1.0 -- Copyright (c) 1992 by Kurtis J. Jones / -Mate Software\n\n") (setq IN_FILE (open (getfiled "\nEnter points filename: " (getvar 'DWGPREFIX) "txt" 16) "r")) (while (setq POINT_LINE (read (strcat "(" (read-line IN_FILE) ")"))) ;Read POINT_LINE from input file (setq POINT_NO (car POINT_LINE)) ;Get the point number (prompt (strcat "\nPlotting point no. " (itoa POINT_NO))) (setq POINT (list (caddr POINT_LINE) ;Get easting (cadr POINT_LINE) ;Get northing (last POINT_LINE) ;Get elevation ) ) (entmake (list '(0 . "POINT") (cons 10 POINT))) (entmake (list '(0 . "TEXT") (cons 10 POINT) '(40 . 1) (cons 1 (itoa POINT_NO)))) ) (close IN_FILE) (prompt "\nPOINTPLT finished") (prompt "\n ") (eop) )

the goat has something for this. http://www.lee-mac.com/copytodrawing.html

Bricscad has a make block where it looks at patterns of objects, Ask company to send un exploded, they just dont want you to use there blocks.

(setq IN_FILE (open (getfiled "\nSelect Points File" (getvar 'DWGPREFIX) "txt" 16) "r")) This will start in the same folder as the drawing change "txt" to the file extension your looking for. --edit-- I would also make sure to the file is formatted correctly. when I make a point its asking for x y z cords in that order but the lisp seems to be pulling P# y x z. Also Im on BrisCAD so i had to update the text command to work properly

You might select the file using (getfiled ?

IIRC, you can do Tabs in a VBA User Form. Like mentioned, OpenDCL, but needs installed on all machines, which may not be a big deal or could be a show stopper. As mentioned AutoCAD DCL doesn't do tabs, you will have to fake it, plain and simple. Go HERE and check out DCL_Tiles

This is as name implies goto layout, "Model" is layout 0. Just remove all the choose part. Goto-layout.lsp

Hopefully not 7 years too late... (defun c:unfold ( / ang bpt ent lst ocs par ) (while (progn (setvar 'errno 0) (setq ent (car (entsel))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil ) ( (or (vl-catch-all-error-p (setq par (vl-catch-all-apply 'vlax-curve-getendparam (list ent)))) (null par)) (princ "\nInvalid object selected.") ) ) ) ) (if (and (= 'ename (type ent)) (setq bpt (getpoint "\nSpecify base point: ")) (setq ang (getangle "\nSpecify line direction: " bpt)) ) (progn (setq ocs (trans '(0 0 1) 1 0 t)) (if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE") (repeat (setq par (fix (+ 1e-8 par))) (setq lst (cons (cons 010 (trans (polar bpt ang (vlax-curve-getdistatparam ent par)) 1 ocs)) lst) par (1- par) ) ) (setq lst (list (cons 010 (trans (polar bpt ang (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))) 1 ocs)))) ) (entmake (append (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 090 (1+ (length lst))) '(070 . 0) ) (cons (cons 010 (trans bpt 1 ocs)) lst) (list (cons 210 ocs)) ) ) ) ) (princ) ) The above should work with any curve object of finite length.

That's why I left it dynamic always a better way. little googling (defun c:ZAL (/) ;; Zoom extents in All Layouts (excluding Model) ;; Alan J. Thompson (vl-load-com) (or *Acad* (setq *Acad* (vlax-get-acad-object))) (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument *Acad*))) ((lambda (ctab) (foreach layout (layoutlist) (setvar 'ctab layout) (vla-put-mspace *AcadDoc* :vlax-false) (vla-zoomextents *Acad*) ) (setvar 'ctab ctab) ) (getvar 'ctab) ) (vlax-for i (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (if (= (vla-get-taborder i) 1) (setvar 'ctab (vla-get-name i)))) (princ) )

So this is an example of the Script I make up, if you can write to a text file then all the parts are out there that you need, for example Lee Mac has a LISP top select files which you can use to open / close / take references from and so on LOAD "C:\\Users\\Me\\AppData\\Local\\Temp\\batchscrlisps.lsp" ;;loads a LISP file in case it isn't loaded LOAD "C:\USERS\Me\DESKTOP\AUTOCAD\AUTOCAD LISPS\ZOOMS.LSP" ;;loads another LISP file in case it isn't loaded ZA ;;LISP command as you'd type into command line, here ZA = Zoom All layout1 ;;Another LISP commmand as above, here switch to layout 1 (c:batchsaveas "" "" "" "") ;;Another LISP commmand.. here save as (without dialogue box) _.OPEN "C:\Users\Me\Drawings\ABC-EFG-111_P1.dwg" ;;Open drawing B LOAD "C:\\Users\\Me\\AppData\\Local\\Temp\\batchscrlisps.lsp" ;;As before for these 5 lines LOAD "C:\USERS\ME\AUTOCAD\AUTOCAD LISPS\ZOOMS.LSP" ZA layout1 (c:batchsaveas "" "" "" "") _.OPEN "C:\Users\Me\Drawings\EFG-HIJ-222_P1.dwg" ;;Open drawing C (vla-close (vla-item (vla-get-documents (vlax-get-acad-object)) "ABC-DEF-111_P1.dwg") :vlax-false) ;;Close drawing B LOAD "C:\\Users\\Me\\AppData\\Local\\Temp\\batchscrlisps.lsp" ;;as before LOAD "C:\USERS\ME\AUTOCAD\AUTOCAD LISPS\ZOOMS.LSP" ZA layout1 (c:batchsaveas "" "" "" "") _.OPEN "Drawing1.dwg" (vla-close (vla-item (vla-get-documents (vlax-get-acad-object)) "EFG-HIJ-222_P1.dwg") :vlax-false) ;;Close drawing C LOAD "C:\\Users\\Me\\AppData\\Local\\Temp\\batchscrlisps.lsp" ;;I don't thinK I need these 6 lines... have to check anotherr time LOAD "C:\USERS\ME\AUTOCAD\AUTOCAD LISPS\ZOOMS.LSP" ZA layout1 (c:batchsaveas "" "" "" "") (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "(c:batchclose)") This is saved in my temp file and is run with.. this is the key part maybe? (command "_.SCRIPT" tempscript) ;;run script where tempscript is the script file and file path Look through this and other examples online and see where you get to, use write to a text file to create the script if you want to do it all through CAD

Here is the final lisp, I've added the option for the user to choose if to add the background mask or not. ;;------------------------------------ DIMLP.LSP - label lines (Pipes) with detailed layer name---------------------------------;; ;; fixo () 2012 * all rights released ;; edited 3/3/12 ;; label lines (Pipes) with layer name (defun C:DIMLPDET_UPDATE2(/ *error* acsp adoc ang curve deriv en mid mp ppt1 ppt2 prex sset txh txt txt1 txt2 txtln txtpt1 insut LAYERNAME offst pipetype pipepn a theMText) (vl-load-com) (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (defun *error* (msg) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (cond ((or (not msg) (member msg '("console break" "Function cancelled" "quit / exit abort")) ) ) ((princ (strcat "\nError: " msg))) ) (princ) ) (initget "Current Pipe") (if (null (setq YN (getkword "\nChoose Text Layer [Current/Pipe] <Pipe>: "))) (setq YN "Pipe") ) (initget "Yes No") (if (null (setq Bg (getkword "\nAdd Text Background [Yes/No] <No>: "))) (setq Bg "No") ) (setq ht (getreal "\nSet Length factor (If Drawing Units mm-Set 1000, If Drawig Units m-Set 1)<1000>: ")) (if (= ht nil) (setq ht (atof "1000")) ) (setq ht (/ 1 ht)) (setq txh1 (getreal "\nEnter text height<36>: ")) (if (= txh1 nil) (setq txh1 36) ) (setq pipetype (getstring T "\nPipe Type<PVC PIPE>: ")) (if (= pipetype "") (setq pipetype "PVC PIPE") ) (setq a (substr " " 1 1)) (setq pipetype (strcat pipetype a)) ; (setq pipepn (strcase (getstring "\nPipe Type</6>: "))) ; (if (= pipepn "") ; (setq pipepn "/6") ; ) (setq offst (/ txh1 2)) (setq insut (getvar "insunits")) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) acsp (vla-get-block(vla-get-activelayout adoc))) (vla-startundomark adoc ) (setq txh txh1 prex (getvar "dimdec") ) (while (not sset) (setq sset (ssget '((0 . "*LINE"))) ) ) (while (setq en (ssname sset 0)) (setq curve (vlax-ename->vla-object en)) ;;(setq txt1 (rtos (vla-get-length curve) 2 2)) (setq txtln (if (= (getvar "measurement") 0) (rtos (vla-get-length curve) 3 2) (rtos (vla-get-length curve) 2 2)) ) (setq txtln (atof txtln)) (setq txtln (rtos (* txtln ht) 2 2)) (setq LAYERNAME (vla-get-layer curve)) (setq mid (/ (abs (- (vlax-curve-getendparam curve) (vlax-curve-getstartparam curve))) 2.) mp (vlax-curve-getpointatparam curve mid) deriv (vlax-curve-getfirstderiv curve (vlax-curve-getparamatpoint curve mp)) ) (if (zerop (cadr deriv)) (setq ang 0) (setq ang (- (/ pi 2) (atan (/ (car deriv) (cadr deriv))))) ) (if (< (/ pi 2) ang (* pi 1.5)) (setq ang (+ pi ang)) ) ;;; (setq ppt1 (polar mp (+ ang (/ pi 2)) (* txh 0.5)) ;;; ) (setq ppt1 (polar mp (+ ang (/ pi 2)) offst) ) (setq txtpt1 (vlax-3d-point (trans ppt1 1 0))) ;;; (setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(setq txt (strcat LAYERNAME pipepn)) (setq txt (strcat LAYERNAME " L=" (strcat txtln "m"))) (setq txt (vl-string-subst pipetype "P_" txt)) (setq txt (vl-string-subst "/" "-" txt)) (setq theMText (vla-AddMText mspace txtpt1 (atof "0") txt)) (vla-put-AttachmentPoint theMText acBottomCenter) ;;(vla-put-alignment theMText acAlignmentBottomCenter) ;;(vla-put-textalignmentpoint theMText txtpt1) ;;(vla-put-insertionpoint theMText (vla-get-textalignmentpoint theMText)) (vla-put-rotation theMText ang) (vla-put-Height theMText txh) (if (= Bg "Yes") (progn (vla-put-backgroundfill theMText :vlax-true) (setq dxf_ent (entget (entlast))) (entmod (append dxf_ent '((90 . 1) (63 . 254) (45 . 1.1) (441 . 0)))) ) ) (if (= YN "Pipe") (vlax-put-property theMText 'layer LAYERNAME) ) ;(setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(vla-put-alignment txt1 acAlignmentBottomCenter) ;(vla-put-textalignmentpoint txt1 txtpt1) ;(vla-put-insertionpoint txt1 (vla-get-textalignmentpoint txt1)) ; (vla-put-rotation txt1 ang) ;(if (= YN "Pipe") ; (vlax-put-property txt1 'layer LAYERNAME) ; ) (ssdel en sset) ) (*error* nil) (princ) ) (princ "\n\t---\tStart command with \"DIMLPDET\"\t---") (princ) (or (vl-load-com) (princ)) ;;------------------------------------ code end ----------------------------------;;

Yes, double click inside the viewport to make it active and then work on your drawing there. As for good practice, I do most of my work inside the viewports, but someone else might do most of their work in model space. It really depends on what you're working on.

Using ssget with text filter can get all text, then sort, then check string length. NOTE text only at this stage not mtext. ; look for short text and replace ; BY AlanH Feb 2022 ; By Gile (defun remove_doubles (lst) (if lst (cons (car lst) (remove_doubles (vl-remove (car lst) lst))) ) ) (defun AH:replacetext (oldtext anstxt / k ent2 extxt num) (repeat (setq k (sslength ss)) (setq ent2 (vlax-ename->vla-object (ssname ss (setq k (- k 1))))) (setq extxt (vla-get-textstring ent2)) (if (= extxt oldtext) (vla-put-textstring ent2 anstxt) ) ) ) (defun c:shrtxt ( / lst ss ent lst2 ans) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq num (atoi (car (AH:getvalsm (list "Num Characters" "less than " 5 4 "3"))))) (setq ss (ssget "X" '((0 . "TEXT")))) (setq lst '()) (repeat (setq x (sslength ss)) (setq ent (entget (ssname ss (setq x (1- x))))) (setq lst (cons (cdr (assoc 1 ent)) lst)) ) (setq lst2 (remove_doubles lst)) (setq lst2 (vl-sort lst2 '<)) (foreach txt lst2 (if (< (strlen txt) num) (progn (setq ans (car (AH:getvalsm (list "Replace text" "New text" 20 19 txt)))) (AH:replacetext txt ans) ) ) ) (princ) ) (c:shrtxt)

Allows user to draw slope lines. SLOPE-LINE.LSP