Leaderboard

I just discovered this and anybody wanting to do things with Excel should welcome this, it has multiple functions. I use a couple of FIXO functions now and his efforts to talk to Excel had a huge catalogue. Please note these functions expect a coder has a good knowledge of lisp and how to use defuns etc. XLFIXOLIB.zip

Two choices per letter upper or lower case 5 letters 2^5 = 32 possible choices. either do it lee's way (best) or use the strcase funciton to convert everything to upper case and check that way.

(defun c:t1 ( / ss l mid-pt ss->el) (defun mid-pt (e / x) (setq x (entget e))(mapcar '* (mapcar '+ (cdr (assoc 10 x)) (cdr (assoc 11 x))) '(0.5 0.5 0.5))) (defun ss->el (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l) (if (setq ss (ssget (list (cons 0 "Line")))) (setq l (vl-sort (ss->el ss) '(lambda (a b) (< (cadr (mid-pt a)) (cadr (mid-pt b))))))) (setq ss (ssadd) i -2) (while (setq e (nth (setq i (+ i 2)) l))(ssadd e ss)) (command "chprop" ss "" "color" "red" "") ) load code , start with t1 or (c:t1) , select the lines with window or crossing (no problem selecting the leaders also because they are filtered out anyway so don't worry , be happy) et voila...

it may be a bug I fixed a while ago by not first saving text before starting properties dialog. I'll attach latest version I have, it has a few more (undocumented) bells & whistles but in its core its still the same. VT.LSP Note that some functions / buttons will not work because they only function on my company network like button 'serv' in main dialog and also revision in quick menu only works with my company's titleblocks.

(defun c:MyHatch() (setq ss (ssget "X" (list '(0 . "LWPOLYLINE") '(70 . 1)))) (repeat (setq i (sslength ss)) (setq p (ssname ss (setq i (1- i)))) (setq pl (entget p) lay (assoc 8 pl) color (assoc 62 pl) ) (command "_hatch" "s" p "") (setq hatch (entget (entlast)) hatch (subst lay (assoc 8 hatch) hatch) ) (cond (color (setq hatch (append hatch (list color)))) ) (entmod hatch) ) (setq ss nil) ) Just a quick one...

Maybe - (defun 2parea ( p1 p2 ) (abs (apply '* (mapcar '- p2 p1 '(0 0)))) )

But in all practicality, only these 3 will ever be used, very unlikely to have "floOr9" for example. Lee Macs example covers all 25 cases well

(ssget "W" pt1 pt2 '((0 . "TEXT") (1 . "[Ff][Ll][Oo][Oo][Rr]9")))

Should work as desired... (defun c:txtby2pts ( / p1 p2 txt txtbox v w h ) (initget 1) (setq p1 (getpoint "\nFirst point : ")) (initget 1) (setq p2 (getcorner p1 "\nSecond point : ")) (setq txt (getstring t "\nText : ")) (vl-cmdf "_.text" "_j" "_l" "_non" p1 1.0 0.0 txt) (setq txtbox (textbox (list (assoc 1 (entget (entlast)))))) (setq v (mapcar '- p2 p1)) (setq w (car v) h (cadr v)) (vl-cmdf "_.scale" (entlast) "" "_non" p1 h) (setpropertyvalue (entlast) "WidthFactor" (/ (/ w h) (- (caadr txtbox) (caar txtbox)))) (princ) ) HTH. M.R.

@mhuppFWIW ;; This (setq atts (vlax-safearray->list (vlax-variant-value (vla-getattributes blk)))) ;; Returns the same as this (setq atts (vlax-invoke blk 'getattributes)) ;; At least in AutoCAD

@elli0t Find attached lisp and result dwg the new command is LAST-CELL sum table last cell.LSP sum Tables last cell.dwg

Build a selection set of blocks with attributes. for each block step thought each attribute and save the "type" and "manufacturer_code" if type is a matches a predefined list '("Base Cabinets" "Wall Cabinets" "Tall Cabinets") then get a bounding box of the current block. calculate the mid point and create text with the "manufacturer_code" at the mid point. ;;----------------------------------------------------------------------------;; ;; Pull Manufacturer_Code for cabinets and input them center of block (defun C:CAB-Label (/ Drawing ss blk atts att typ man minpt maxpt MPT) (vl-load-com) (setq i 0) (vla-startundomark (setq Drawing (vla-get-activedocument (vlax-get-acad-object)))) (prompt "\nSelect Blocks: ") (while (setq ss (ssget '((0 . "INSERT") (66 . 1)))) ;allows user to make multiple selections (setvar 'cmdecho 0) (foreach blk (mapcar 'vlax-Ename->Vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (setq atts (vlax-invoke blk 'getattributes)) (setq typ "" man "") (foreach att atts (cond ((= (vla-get-tagstring att) "Type") (setq typ (vla-get-textstring att)) ) ((= (vla-get-tagstring att) "Manufacturer_Code") (setq man (vla-get-textstring att)) ) ) ) (if (member typ '( "Base Cabinets" "Wall Cabinets" "Tall Cabinets")) ;update list for other blocks (progn (vla-GetBoundingBox blk 'minpt 'maxpt) (setq MPT (mapcar '/ (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2 2))) (entmake (list '(0 . "TEXT") (cons 10 MPT) (cons 11 MPT) (cons 40 (getvar 'textsize)) (cons 1 man) '(62 . 1) '(72 . 1) '(73 . 2))) (setq i (1+ i)) ) ) ) ) (prompt (strcat "\n" (itoa i) " Cabinets labeled")) ;message at the end (vla-endundomark Drawing) (setvar 'cmdecho 1) (princ) )

Manually trim select mline then pick point at midpoint of each side of red plines seems to work. So get all rectangs do a offset and get te co-ords of that new pline then use ssget "F" to get the touching mlines, the trim point is mid of the 2 mlines points. ; https://www.cadtutor.net/forum/topic/77526-how-to-trim-the-intersected-line-between-mline-polyline/ ; Trim mlines touching plines ; by AlanH May 2023 (defun c:cuts ( / ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq ss (ssget '((0 . "lwpolyline")))) (if ss (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (1- x)))) (setq obj (vlax-ename->vla-object ent)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq co-ord (cons (last co-ord) co-ord)) (command "offset" 10 ent (getvar 'extmax) "") (setq co-ord2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast))))) (setq co-ord2 (cons (last co-ord2) co-ord2)) (entdel (entlast)) (setq ss2 (ssget "f" co-ord2 '((0 . "MLINE")))) (setq mpts '()) (repeat (setq j (sslength ss2)) (setq ent2 (ssname ss2 (setq j (1- j)))) (setq obj2 (vlax-ename->vla-object ent2)) (setq intpts (vlax-invoke obj 'intersectWith obj2 acExtendThisEntity)) (setq mp (mapcar '* (mapcar '+ (list (nth 0 intpts) (nth 1 intpts) 0.0)(list (nth 3 intpts) (nth 4 intpts) 0.0)) '(0.5 0.5 0.5))) (setq mpts (cons mp mpts)) ) (command "trim" ss2 "") (foreach pt mpts (command pt) ) (command "") ) (alert "no plines") ) (princ) ) (c:cuts)

When I say simple, I mean the font used. If everything is horizontal and pretty much all simplex, that would be an easy conversion to run a script in batch of drawings. One other thing, you might try this VectPDF download | SourceForge.net I used it prior to AutoCAD having the import PDF function. Not sure if it has had any updates in a while. As for SHX fonts, you can make them comments when plotted to PDF. Acrobat can plot them as searchable with PDFMaker. (I am not sure how that comes back into AutoCAD, though.) True Type Fonts can also be made non-searchable, so not foolproof either. (I am not sure how that comes back into AutoCAD, either.) How to create selectable and searchable text in a PDF from AutoCAD (autodesk.com) Unfortunately, OCR has been used a lot more for creating image text to editable text, much more development in that area I would surmise, I had some very good OCR software that came with a scanner way back in the 80s. I have found very little on batch converting, either in AutoCAD, Adobe or others. Acrobat may be able to batch convert, I am not sure on that. I would just suggest pick a method and get to work on them manually.

Ok 2d and 3d poly co-ordinates sample code. ; pline co-ords example ; By Alan H (defun getcoords (ent) (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object ent) "Coordinates" ) ) ) ) ; convert now to xyz (defun co-ords2xy (xyz / ) (setq co-ordsxy '()) (if (= xyz 2) (progn (setq I 0) (repeat (/ (length co-ords) 2) (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) )) (setq co-ordsxy (cons xy co-ordsxy)) (setq I (+ I 2)) ) ) ) (if (= xyz 3) (progn (setq I 0) (repeat (/ (length co-ords) 3) (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) )) (setq co-ordsxy (cons xy co-ordsxy)) (setq I (+ I 3)) ) ) ) ) (defun c:wow ( / ) (setq obj (vlax-ename->vla-object (car (entsel "Pick obj")))) (setq co-ords (vlax-get obj 'coordinates)) (cond (( = (vla-get-objectname obj) "AcDb2dPolyline")(co-ords2xy 2)) (( = (vla-get-objectname obj) "AcDb3dPolyline")(co-ords2xy 3)) ) (princ co-ordsxy) (foreach pt co-ordsxy (setq pt (list (car pt)(cadr pt) (caddr pt))) (command "text" "C" pt 1.5 0.0 (rtos (caddr pt) 2 2)) ) (princ) ) (c:wow)

and another way: (DEFUN C:SD ( / ) (setq P1 (GETPOINT "\n Pick Start Point :") ) (setq P2 (GETPOINT P1 "\n Pick End Point :") ) (setq EV (GETREAL "\n Enter Distance :") ) (setq XY (mapcar '+ (list EV 0 0) P1)) (COMMAND "POINT" P1) ; POINT P1 (COMMAND "POINT" P2) ; POINT P2 (COMMAND "POINT" XY) ; NEW POINT FROM P1 X - AXIS VALUE FOR EV DISTANCE (PRINT XY) ) EDITED CODE SLIGHTLY

(command "chprop" (ssget "_:L-I") "" "COLOR" "t" "255,51,204" "") (Crayola Razzle Dazzle Rose colour....) and I don't care,. this is the lisp name, like it or not,. (defun c:Lauper ( / ) ; True colours. (setq MyEnt (car (entsel))) (setq MyObj (vlax-ename->vla-object MyEnt)) ;;https://adndevblog.typepad.com/autocad/2012/12/accessing-the-truecolor-property-using-visual-lisp.html (setq oColor (vlax-get-property MyObj 'TrueColor) clrR (vlax-get-property oColor 'Red) clrG (vlax-get-property oColor 'Green) clrB (vlax-get-property oColor 'Blue) ) ;;Match colour (princ "Thanks, select objects to change") (command "chprop" (ssget "_:L-I") "" "COLOR" "t" (strcat (rtos clrR) "," (rtos clrG) "," (rtos clrB)) "") )

Use this ;;; just72 (left->0, center->1, right->2,aligned (if vertical alignment=0)->3) ;;; just73 (baseline->0, bottom->1, middle->2,top->3) (cons 72 just72) ;;; Horizontal Alignment (cons 73 just73) ;;; Vertical Alignment ;; or if you are using "just" numbers '(72 . 1) '(73 . 2) And the insertion point should be 11 instead of 10

I have been very busy but will try tonight.

If you are using CIV3D do PURGESTYLESANDSETTINGS 1st this removes a lot of stuff from your CIV3D dwg, but a warning do at end of project. Can though IMPORTSTYLESANDSETTINGS and get them all back. Any block linked to a CIV3d style will not be purged using just purge.

Many years ago I tried to draw stereograms (like this: https://en.wikipedia.org/wiki/Autostereogram ). I used to use Lisp for drawing on AutoCAD’s screen, then I saved the resulted image. I remember at that time I was wondering if I could leave-out AutoCAD, to make AutoLisp to write the data directly into a bitmap file. It didn’t work, Lisp can’t write binary. But these days I returned to that (to writing files, not to stereograms). Lisp can’t write binary, but it can write ordinary text files. So after getting the file right, the rest is just a question of conversion. I downloaded a free hex editor (https://mh-nexus.de/en/hxd/). Now: I use Lisp from inside AutoCAD to write the text file. I open it with Notepad, copy/paste the data in the hex editor and from there I save the file with BMP extension. Here are two samples -converted to GIF with Irfanview (https://www.irfanview.com/) just for uploading in the Forum. And here is a Lisp: (defun c:bmp() (setq file (open "C:\\Users\\miklos.fuccaro\\Desktop\\MyBitmap.tXt" "W")) (setq null4 "00 00 00 00") ; file header: (write-line "42 4d" file) ;Magic Bytes (write-line null4 file) ;File size (write-line null4 file) ;Reserved 1+2 (write-line "36 00 00 00" file) ;Data offset ! ; Image header: (write-line "28 00 00 00" file) ;Heder size (write-line "ff 00 00 00" file) ;image width ! (write-line "ff 00 00 00" file) ;image height ! (write-line "01 00" file) ;Color Planes (write-line "10 00" file) ;Bits / Pixel ! (write-line null4 file) ;No compressions (write-line null4 file) ;Image size (write-line null4 file) ;X pix per m (write-line null4 file) ;Y pix / m (write-line null4 file) ;Colors (write-line null4 file) ;Important colors ; Pixel data: ;| ; saturn (setq col1 "08 08" col2 "1d 00" col3 "ff 1c" cx 115 cy 100 rDisc 50 rX 97 rY 14 i 0) (repeat 256 (setq i (1+ i) j 0) (repeat 256 (setq j (1+ j)) (setq dx (- cx j) dy (- cy i) dx (* dx dx) dy (* dy dy)) (setq onDisc (if (< (+ dx dy) (* rDisc rDisc)) 1 nil)) (setq ell (+ (/ (* (- i cy) (- i cy)) (* rY rY 1.0)) (/ (* (- j cX) (- j cX)) (* rX rX 1.0)))) (setq onEllipse (if (equal ell 1 0.4) 1 nil)) (setq str (if onDisc col2 col1)) (cond ((and onEllipse (= str col1)) (setq str col3)) ((and onEllipse (= str col2) (< i cy)) (setq str col3)) ) (write-line str file) ) ) |; ; tree (setq col1 "ff 2d" col2 "e0 03" col3 "00 1c" col4 "c0 09"r1 0.03 r2 0.65 i 256) (repeat 256 (setq i (1- i) j 0) (repeat 256 (setq str (if (< i 200) col1 col4)) (setq j (1+ j)) (setq str (if (< (abs (- j 90)) (* (rem i (+ 45 (/ i 7))) r2)) col2 str)) (setq str (if (< (abs (- j 90)) (* i r1)) col3 str)) (write-line str file) ) ) (close file) (princ "OK") (princ) )

like this? (haven't tested it because temp. out of acces to AutoCad so just pasted something together in notepad) ; independent simple dialog for getstring so no switching needed from dialog to command line (_ask "How are you?") (defun _ask ( $m / f p d r s) (if (and (setq f (vl-filename-mktemp ".dcl"))(setq p (open f "w"))) (progn (write-line (strcat "ask :dialog {label =\"" $m "\";:edit_box {key=\"eb\";}spacer;ok_cancel;}") p)(close p)(gc) (setq d (load_dialog f))(new_dialog "ask" d) (mapcar '(lambda(x y)(action_tile x y)) '("eb" "accept" "cancel") '("(chk_val $value)""(done_dialog 1)""(done_dialog 0)"))(setq r (start_dialog))(unload_dialog d)(vl-file-delete f))) (if (and (= r 1) (= 'STR (type s)) (/= s "")) s nil) ) (defun chk_val (v) (if (and (not (null v))(eq (type v) 'STR)(not (eq v ""))) ;;; if part of larger dialog write back to edit box ;;; (set_tile "eb" (setq s (strcat (vl-string-trim "\"" v) "\""))) ;;; else just return value (setq s (strcat (vl-string-trim "\"" v) "\"")) ) ) (defun c:t1 ( / r ) (if (setq r (_ask "how many inches ?"))(alert (strcat "result = " r))) (princ) )

There are more than 25 cases... Combinations are included : 5!/2! = 60 cases... I think that Steven P is right - 25 cases... Actually I've found 16 cases... Here is what I founded : 1.floor 2.fLoor 3.flOor 4.floOr 5.flooR 6.Floor 7.FlOor 8.FloOr 9.FlooR 10.FLoor 11.FLoOr 12.FLooR 13.FLOor 14.FLOOr 15.FLOoR 16.FLOOR

So what I think is happening In your final selection set, sel2, you are cleaning up the drawing a bit and then deleting items. If this selection set doesn't exist (ie. it didn't find anything), then the erase is erasing nil I think something to this effect: (command _erase "" "") Nil acting like an enter / space, the second "" is again like another enter / space which is repeat the last command line input "HPO" - and since HPO is a LISP and not a command, HPO is an unknown command. If you do something to fix that it should work, something like this at the end: (if (= sel2 nil) () ; if sel2 is a 'nil' selection, do nothing (command "_erase" sel2 "") ; if sel2 is a selection, then erase it )

As stated before, it can all be reproduced, best you can do is make it very difficult. If there are any dimensions or even standard objects like windows, doors, eave heights, etc. it's even easier. Make everything a block and set to an odd scale in x and y then explode will help distort the drawing. Lots of other "tricks" as well. Watermarks are not very effective in the short term, one of the easiest deterrents to remove from a drawing. Already several threads on this.

You can add your text style along with the layer name to the program if you wish. (defun c:Test (/ int sel cad ent get 1st 2nd sum num ins txt lst dig pos ) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (princ "\nSelect rectangle with four corners to count texts within : ") (setq int -1 sel (ssget '((0 . "LWPOLYLINE") (90 . 4)))) (setq cad (vlax-get-acad-object)) (or (vla-zoomExtents cad) t) (while (setq int (1+ int) ent (ssname sel int)) (and (setq get (entget ent) 1st (assoc 10 get) 2nd (cdr (assoc 10 (cdr (member (assoc 10 (cdr (member 1st get))) get)))) ) (setq sum 0.0 num -1 ins (ssget "_W" (setq 1st (cdr 1st)) 2nd '((0 . "TEXT")))) (while (setq num (1+ num) txt (ssname ins num)) (and (setq lst (entget txt)) (numberp (setq dig (read (cdr (assoc 1 lst))))) (setq sum (+ sum dig)) ) ) ) (entmake (list '(0 . "TEXT") (cons 10 (setq pos (mapcar '(lambda (j k) (/ (+ j k) 2.0)) 1st 2nd))) (cons 1 (if (> sum 0.0) (rtos sum 2 2) "0.00")) '(40 . 0.36) (cons 11 pos) '(71 . 0) '(72 . 1) '(73 . 2))) ) (vla-ZoomPrevious cad) ) (princ) ) (vl-load-com)

This should work Command SNR (for Sum Numbers in Rectangles) (vl-load-com) ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawText (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str)))) ;; LW Vertices - Lee Mac ;; Returns a list of lists in which each sublist describes ;; the position, starting width, ending width and bulge of the ;; vertex of a supplied LWPolyline (defun LM:LWVertices ( e ) (if (setq e (member (assoc 10 e) e)) (cons (list (assoc 10 e) (assoc 40 e) (assoc 41 e) (assoc 42 e) ) (LM:LWVertices (cdr e)) ) ) ) (defun getVertices ( pline / verts vert res) (setq verts (LM:LWVertices (entget pline) )) (setq res (list)) (foreach vert verts (setq p (cdr (assoc 10 vert))) (setq res (append res (list p))) ) res ) ;; returns (list min-x min-y max-x max-y) (defun getWindow (pointlist / i min-x min-y max-x max-y) (setq i 0) (foreach point pointlist (if (= i 0) (progn ;; first point (setq min-x (nth 0 point)) (setq min-y (nth 1 point)) (setq max-x (nth 0 point)) (setq max-y (nth 1 point)) progn) (progn (if (< (nth 0 point) min-x)(setq min-x (nth 0 point))) (if (< (nth 1 point) min-y)(setq min-y (nth 1 point))) (if (> (nth 0 point) max-x)(setq max-x (nth 0 point))) (if (> (nth 1 point) max-y)(setq max-y (nth 1 point))) progn) ) (setq i (+ i 1)) ) (list min-x min-y max-x max-y) ) ;; Sum Numbers in Rectangles (defun c:snr ( / pline verts window ss ss0 sum numb th i j) (setq th 1.0) ;; default text height (setq j 0) (princ "\nSelect the rectangles: ") (setq ss0 (ssget (list (cons 0 "*POLYLINE") ) )) (princ (sslength ss0) ) (repeat (sslength ss0) ;; (setq pline (entsel "\nSelect Rectangle: ")) (setq pline (ssname ss0 j)) (if pline (progn (setq sum 0.0) (setq verts (getVertices pline)) (setq window (getWindow verts)) ;; get all texts inside that window (setq ss (ssget "w" (list (nth 0 window) (nth 1 window)) (list (nth 2 window) (nth 3 window)) (list (cons 0 "TEXT") ))) (setq i 0) (if ss (progn (repeat (sslength ss) (princ "\n") (setq numb (atof (cdr (assoc 1 (entget (ssname ss i)))))) ;; sum (setq sum (+ sum numb)) (princ numb) (setq i (+ i 1)) ) ;; text height (setq th (cdr (assoc 40 (entget (ssname ss 0))))) (drawText (list (/ (+ (nth 0 window) (nth 2 window) ) 2) (/ (+ (nth 1 window) (nth 3 window) ) 2)) th (rtos sum 2 2) ) ) ;; no text found in rectangle (drawText (list (/ (+ (nth 0 window) (nth 2 window) ) 2) (/ (+ (nth 1 window) (nth 3 window) ) 2)) th "0.0" ) ) (princ "\n\n") (princ sum) )) (setq j (+ j 1)) ) (princ) )

What software did you use to screen cap? looks like its just a rounding error when your only inputting two digits for the length. Then you need to update the value of YV and add the next one to it to get the right value. 7.200+(-2.39969)=4.80031 4.80031+(-2.00037)=2.79994 if you want to keep the code the way it is see if this works for you. (defun C:LA (/ P1 P2 P3 P4 AL EL ANG XV YV) (setq P1 (getpoint "\n PICK FIRST POINT OF REF-LINE:") P2 (getpoint P1 "\n PICK SECOND POINT OF REF-LINE:") AL 0 YV 0 ;added code ) (command "UCS" "3" P1 P2 "") (while (setq P3 (getpoint "\n PICK FIRST POINT :") P4 (getpoint P3 "\n PICK SECOND POINT :") ) (setq EL (distance P3 P4) ;don't need to input just calc the distance from the two points. will also get rid of rounding errors. AL (+ AL EL) ANG (angle P3 P4) XV (* (cos ANG) AL) YV (+ YV (* (sin ANG) EL)) ;update value like your doing with AL ) (prompt (strcat "\n" (rtos XV 2))) (prompt (strcat "\n" (rtos YV 2))) ) ) Improved code only have to pick the two polylines and one point to get the values you want. Benefits: Selecting any point on the polyline with nearest not just endpoints midpoint. Can select points out of order or only points you want to check. ref line doesn't need to start at same point the measured line does. Only problem I see is if the polyline is started from the other side it will need to be reversed to give the correct Distance. and the refence line needs to be longer then the polyline being measured or it wont give the right Y value. Example. (defun C:LA_improved (/ ref line P1 P2) (setq ref (car (entsel "\n Pick Reference Line"))) (setq line (car (entsel "\n Pick Polyline to Measure"))) (while (setq P1 (getpoint "\n Pick Point on Line :")) (setq P2 (vlax-curve-getClosestPointTo ref P1)) (prompt (strcat "\nX: " (rtos (vlax-curve-getdistatpoint line P1) 2))) (prompt (strcat "\nY: " (rtos (distance P1 P2) 2))) ) ) props to vlax-curv functions

ok , updated code one last time. I saw you changed the name to SLD so I updated this to. Also added button to open csv with excel or notepad and added publish option in case you also want single pdf. ;;; SLD : Single Line Drawing by Smitaranjan ;;; Last update : 2023-05-06 - new scenarios ;;; Last update : 2023-05-18 - new scenarios (defun c:SLD ( / OldErr SLD_Err regkey regvar prog-base csv-data-list old-osm ActApp ActDoc ActLay ActSpace SLD-PlotDevices SLD-Papersizes SLD-PlotStyles SLD-PlotRange SLD-PlotInitialized #SLD-data-Source-Filename #SLD-Symbol-Source-Folder #SLD-Drawing-Output-Folder #SLD-MaxNofColumns #SLD-ColumnDistance #SLD-MaxNofRows #SLD-RowDistance #SLD-BorderSize #SLD-Start-Point-X #SLD-Start-Point-X #SLD-Line-Color #SLD-Symbol-Color #SLD-Text-Color #SLD-LastPlotDevice #SLD-LastPaperSize #SLD-LastPlotStyle #SLD-LastPlotRange #SLD-Print-Each-Diagram #SLD-Publish) (SLD_Init) (SLD_Main_Dialog_Start) (if (eq #SLD-Publish "1")(_publish))(SLD_Exit)(princ)) (princ "\nSingle Line Generator - Last update : 2023-05-18 (new scenarios)") (defun SLD_Init () (defun SLD-Util_Err ($s) (princ $s)(SLD_Exit)(setq *error* OldErr)(princ))(setq OldErr *error* *error* SLD_Err) (setq ActApp (vlax-get-acad-object) ActDoc (vla-get-ActiveDocument ActApp) ActLay (vla-get-activelayout ActDoc) ActSpace (vla-get-modelspace ActDoc)) (if (not (vl-file-directory-p (setq prog-base (strcat (getvar 'MYDOCUMENTSPREFIX) "\\lisp\\"))))(vl-mkdir prog-base)) (setq old-osm (getvar 'osmode))(setvar 'OSMODE 0)(setvar 'cmdecho 0)(InitDefaultRegistrySettings)(ReadSettingsFromRegistry)(SLD_Preload_Data_Source_File)) (defun SLD_Exit () (setvar 'OSMODE old-osm)(setvar 'cmdecho 1) (if (and main-dialog-fn (findfile main-dialog-fn)) (progn (princ (strcat "\nCleaning up temporary dialog file : \n" main-dialog-fn))(vl-file-delete main-dialog-fn))) (if main-dialog-fp (close main-dialog-fp)) (setq *error* OldErr) (gc)(princ)) (defun splitss (s / a c p l d i) (if (and s (= (type s) 'str)(> (strlen s) 0)(setq i 1)(setq d ""))(progn (if (wcmatch (substr s i 1) "#")(setq p "num")(setq p "s")) (while (<= i (strlen s))(if (wcmatch (substr s i 1) "#")(setq c "num")(setq c "s")) (if (= c p)(setq d (strcat d (substr s i 1))) (progn (setq l (append l (list d)) p c d (substr s i 1))))(setq i (1+ i)))(if (and d (/= d ""))(setq l (append l (list d)))))) l) (defun SplitStr (s d / p)(if (setq p (vl-string-search d s))(cons (substr s 1 p) (SplitStr (substr s (+ p 1 (strlen d))) d))(list s))) (defun commatize (l) (apply 'strcat (cdr (apply 'append (mapcar '(lambda (x) (list "," x)) l))))) (defun de-commatize (s / p)(if (setq p (vl-string-search "," s))(cons (substr s 1 p)(de-commatize (substr s (+ p 2))))(list s))) (defun StrRemove (s l)(foreach x l (while (vl-string-search x s) (setq s (vl-string-subst "" x s)))) s) (defun getip ( e / p)(if (and e (setq e (entget e) p (assoc 11 e)) (not (equal p '(11 0.0 0.0 0.0)))) (list (cadr (assoc 11 e))(caddr (assoc 11 e))) (list (cadr (assoc 10 e))(caddr (assoc 10 e))))) (defun GetShellFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application")) (setq f (vlax-invoke s 'browseforfolder 0 m 0 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path)) (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) (if f (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" f)) "\\"))) (defun _getfolder ( m / sh f r )(setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0)) (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\"))))) (defun Dos_Path ($p) (if (= (type $p) 'STR) (strcase (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" $p)) "\\")) "")) (defun vl_path ($p)(if (= (type $p) 'str)(strcat (vl-string-right-trim "\\/" (strcase (vl-string-translate "\\" "/" $p) t)) "/") "")) (defun wai (b a v) (setq a (strcase a) b (ent->vla b)) (if (and (eq (vla-get-objectname b) "AcDbBlockReference") (= (vla-get-hasattributes b) :vlax-true)) (vl-some '(lambda (x) (if (equal a (strcase (vla-get-tagstring x)))(progn (vla-put-textstring x v)(if (not (void #SLD-Text-Color)) (vla-put-color x (atoi #SLD-Text-Color))) v)))(vlax-invoke b 'getattributes)))) (defun tai ( blk tag )(setq tag (strcase tag) blk (ent->vla blk))(setq lst nil)(if blk (vl-some '(lambda (x) (if (equal tag (strcase (vla-get-tagstring x))) (vla-get-textstring x)))(vlax-invoke blk 'getattributes)))) (defun ent->vla (e)(cond ((= (type e) 'VLA-OBJECT) e)((= (type e) 'ENAME)(vlax-ename->vla-object e)) ((and (= (type e) 'STR)(tblsearch "block" e))(ent->vla (ssname (ssget "x" (list (cons 0 "INSERT")(cons 2 e))) 0)))(t nil))) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (defun void (x)(or (not x)(= "" x)(and (listp x)(not (vl-consp x)))(and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x)))))) (defun isnum (n)(if (or (numberp n) (distof n)) t nil)) (defun block-n (o) (if (and (setq o (ent->vla o)) (eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)) nil)) (defun insert_block_vla (bn ip) (if (vl-catch-all-error-p (setq bo (vl-catch-all-apply 'vla-InsertBlock (list ActSpace (vlax-3D-point ip) bn 1.0 1.0 1.0 0.0)))) nil bo)) (defun BlockInsert-VLA (dwg-list)(foreach dwg dwg-list (if (vl-catch-all-error-p (setq b (vl-catch-all-apply 'vla-InsertBlock (list ActSpace ip dwg 1.0 1.0 1.0 0.0))))(put_on_my_naughty_list (strcat dwg "\n** Error: " (vl-catch-all-error-message b) " **")) (progn (and (eq (vla-get-isDynamicBlock b) :vlax-true)(vla-resetBlock b))(vla-delete b))))) (defun vl_delete_everything ( / d)(vl-load-com)(setq d (vla-Get-ActiveDocument (vlax-Get-Acad-Object))) (vlax-map-collection (vla-get-layers d) '(lambda (l)(vlax-put-property l 'lock :vlax-false))) (vlax-for b (vla-get-blocks d)(vlax-for x b (vl-catch-all-apply 'vla-delete (list x))))(vla-purgeall d)(gc)) (defun shell_open ( $f / it sh ) (if (and (not (void $f)) (setq $f (findfile $f)) (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))) (progn (setq it (vl-catch-all-apply 'vlax-invoke (list sh 'open $f)))(vlax-release-object sh)(not (vl-catch-all-error-p it))) (progn (prompt "\nShell application was unable to open file")(setq it nil)))) (defun InitDefaultRegistrySettings () (setq regkey "HKEY_CURRENT_USER\\SOFTWARE\\SLD\\" regvar '(("#SLD-Data-Source-Filename" "")("#SLD-Symbol-Source-Folder" "")("#SLD-Drawing-Output-Folder" "") ("#SLD-MaxNofColumns" "7")("#SLD-ColumnDistance" "50")("#SLD-MaxNofRows" "5")("#SLD-RowDistance" "50")("#SLD-BorderSize" "3")("#SLD-Start-Point-X" "40") ("#SLD-Start-Point-y" "250")("#SLD-Line-Color" "1")("#SLD-Symbol-Color" "2")("#SLD-Text-Color" "7")("#SLD-LastPlotDevice" "Default Windows System Printer.pc3") ("#SLD-LastPaperSize" "A4")("#SLD-LastPlotStyle" "Acad")("#SLD-LastPlotRange" "Extents")("#SLD-Print-Each-Diagram" "1")("#SLD-Publish" "0"))) (mapcar '(lambda (x)(set (read (car x)) (cadr x))) regVar)) (defun ReadSettingsFromRegistry () (mapcar '(lambda (x / n v)(if (setq v (vl-registry-read regkey (setq n (car x)))) (set (read n) v) (vl-registry-write regkey n (cadr x)))) regvar)) (defun WriteSettingsToRegistry ()(mapcar '(lambda (x) (vl-registry-write regkey (car x) (eval (read (car x))))) regvar)) (defun Save_Dialog_Data (%tl) (mapcar '(lambda (x) (eval (car x))) %tl)) (defun Reset_Dialog_Data (%tl %rd) (mapcar '(lambda (x y) (set (car x) y)) %tl %rd)) (defun Set_Dialog_Tiles (%tl) (mapcar '(lambda (x / v) (if (eq 'str (type (setq v (eval (car x))))) (set_tile (cadr x) v))) %tl)) (defun Main_Dialog_Cancel () (Reset_Dialog_Data MainDialog-tl MainDialog-rd) (WriteSettingsToRegistry)) (defun SLD_Main_Dialog_Create ( / lst ) (setq lst (list '(83 76 68 32 58 32 100 105 97 108 111 103 32 123 108 97 98 101 108 61 34 83 76 68 32 45 32 83 105 110 103 108 101 32 76 105 110 101 32 68 105 97 103 114 97 109 32 71 101 110 101 114 97 116 111 114 32 40 82 108 120 32 50 48 50 51 45 48 53 45 49 56 41 34 59 115 112 97 99 101 114 59 58 114 111 119 32 123 103 97 112 59 58 105 109 97 103 101 32 123 104 101 105 103 104 116 61 48 46 49 59 99 111 108 111 114 61 50 53 51 59 125 103 97 112 59 125 115 112 97 99 101 114 59) '(58 98 111 120 101 100 95 99 111 108 117 109 110 32 123 108 97 98 101 108 61 34 68 97 116 97 32 83 111 117 114 99 101 32 70 105 108 101 110 97 109 101 32 40 99 115 118 41 34 59 58 114 111 119 32 123 58 101 100 105 116 95 98 111 120 32 123 101 100 105 116 95 119 105 100 116 104 61 57 54 59 107 101 121 61 34 101 98 95 83 76 68 95 100 97 116 97 95 115 111 117 114 99 101 95 102 105 108 101 110 97 109 101 34 59 125) '(58 98 117 116 116 111 110 32 123 102 105 120 101 100 95 119 105 100 116 104 61 116 114 117 101 59 119 105 100 116 104 61 49 54 59 108 97 98 101 108 61 34 83 101 108 101 99 116 34 59 107 101 121 61 34 98 116 95 83 76 68 95 115 101 108 101 99 116 95 100 97 116 97 95 115 111 117 114 99 101 95 102 105 108 101 110 97 109 101 34 59 125 125) '(58 99 111 110 99 97 116 101 110 97 116 105 111 110 32 123 58 98 117 116 116 111 110 32 123 108 97 98 101 108 61 34 79 112 101 110 32 99 115 118 32 119 105 116 104 32 69 120 99 101 108 34 59 107 101 121 61 34 98 116 95 83 76 68 95 111 112 101 110 95 99 115 118 95 119 105 116 104 95 101 120 99 101 108 34 59 125) '(58 98 117 116 116 111 110 32 123 108 97 98 101 108 61 34 79 112 101 110 32 99 115 118 32 119 105 116 104 32 78 111 116 101 112 97 100 34 59 107 101 121 61 34 98 116 95 83 76 68 95 111 112 101 110 95 99 115 118 95 119 105 116 104 95 110 111 116 101 112 97 100 34 59 125 125 125) '(58 98 111 120 101 100 95 114 111 119 32 123 108 97 98 101 108 61 34 83 121 109 98 111 108 32 83 111 117 114 99 101 32 70 111 108 100 101 114 34 59 58 101 100 105 116 95 98 111 120 32 123 101 100 105 116 95 119 105 100 116 104 61 57 54 59 107 101 121 61 34 101 98 95 83 76 68 95 115 121 109 98 111 108 95 115 111 117 114 99 101 95 102 111 108 100 101 114 34 59 125) '(58 98 117 116 116 111 110 32 123 102 105 120 101 100 95 119 105 100 116 104 61 116 114 117 101 59 119 105 100 116 104 61 49 54 59 108 97 98 101 108 61 34 83 101 108 101 99 116 34 59 107 101 121 61 34 98 116 95 83 76 68 95 115 101 108 101 99 116 95 115 121 109 98 111 108 95 115 111 117 114 99 101 95 102 111 108 100 101 114 34 59 125 125) '(58 98 111 120 101 100 95 114 111 119 32 123 108 97 98 101 108 61 34 68 114 97 119 105 110 103 32 79 117 116 112 117 116 32 70 111 108 100 101 114 34 59 58 101 100 105 116 95 98 111 120 32 123 101 100 105 116 95 119 105 100 116 104 61 57 54 59 107 101 121 61 34 101 98 95 83 76 68 95 100 114 97 119 105 110 103 95 111 117 116 112 117 116 95 102 111 108 100 101 114 34 59 125) '(58 98 117 116 116 111 110 32 123 102 105 120 101 100 95 119 105 100 116 104 61 116 114 117 101 59 119 105 100 116 104 61 49 54 59 108 97 98 101 108 61 34 83 101 108 101 99 116 34 59 107 101 121 61 34 98 116 95 83 76 68 95 115 101 108 101 99 116 95 100 114 97 119 105 110 103 95 111 117 116 112 117 116 95 102 111 108 100 101 114 34 59 125 125 115 112 97 99 101 114 59) '(115 112 97 99 101 114 59 58 114 111 119 32 123 103 97 112 59 58 105 109 97 103 101 32 123 104 101 105 103 104 116 61 48 46 49 59 99 111 108 111 114 61 50 53 51 59 125 103 97 112 59 125 115 112 97 99 101 114 59) '(58 98 111 120 101 100 95 114 111 119 32 123 108 97 98 101 108 61 34 67 111 108 117 109 110 32 38 38 32 82 111 119 32 83 101 116 116 105 110 103 115 34 59 58 99 111 108 117 109 110 32 123 97 108 105 103 110 109 101 110 116 61 99 101 110 116 101 114 100 59) '(58 98 117 116 116 111 110 32 123 107 101 121 61 34 98 116 95 115 101 108 101 99 116 95 115 116 97 114 116 95 112 111 105 110 116 34 59 108 97 98 101 108 61 34 83 116 97 114 116 32 80 111 105 110 116 34 59 125 58 114 111 119 32 123 58 101 100 105 116 95 98 111 120 32 123 107 101 121 61 34 101 98 95 120 95 99 111 111 114 100 34 59 125 32 58 101 100 105 116 95 98 111 120 32 123 107 101 121 61 34 101 98 95 121 95 99 111 111 114 100 34 59 125 125 125) '(115 112 97 99 101 114 59 118 108 105 110 101 59 115 112 97 99 101 114 59 58 99 111 108 117 109 110 32 123 58 116 101 120 116 32 123 108 97 98 101 108 61 34 35 67 111 108 117 109 110 115 34 59 125 58 116 101 120 116 32 123 108 97 98 101 108 61 34 35 82 111 119 115 34 59 125 125) '(58 99 111 108 117 109 110 32 123 58 101 100 105 116 95 98 111 120 32 123 101 100 105 116 95 119 105 100 116 104 61 54 59 107 101 121 61 34 101 98 95 83 76 68 95 109 97 120 95 110 111 102 95 99 111 108 117 109 110 115 34 59 125 58 101 100 105 116 95 98 111 120 32 123 101 100 105 116 95 119 105 100 116 104 61 54 59 107 101 121 61 34 101 98 95 83 76 68 95 109 97 120 95 110 111 102 95 114 111 119 115 34 59 125 125) '(115 112 97 99 101 114 59 118 108 105 110 101 59 115 112 97 99 101 114 59 58 99 111 108 117 109 110 32 123 58 116 101 120 116 32 123 108 97 98 101 108 61 34 67 111 108 46 32 68 105 115 116 46 34 59 125 32 58 116 101 120 116 32 123 108 97 98 101 108 61 34 82 111 119 32 68 105 115 116 46 34 59 125 125) '(58 99 111 108 117 109 110 32 123 58 101 100 105 116 95 98 111 120 32 123 101 100 105 116 95 119 105 100 116 104 61 54 59 107 101 121 61 34 101 98 95 83 76 68 95 99 111 108 117 109 110 95 100 105 115 116 97 110 99 101 34 59 125 58 101 100 105 116 95 98 111 120 32 123 101 100 105 116 95 119 105 100 116 104 61 54 59 107 101 121 61 34 101 98 95 83 76 68 95 114 111 119 95 100 105 115 116 97 110 99 101 34 59 125 125) '(115 112 97 99 101 114 59 118 108 105 110 101 59 115 112 97 99 101 114 59 58 99 111 108 117 109 110 32 123 119 105 100 116 104 61 56 59 125 125 58 98 111 120 101 100 95 114 111 119 32 123 108 97 98 101 108 61 34 67 111 108 111 114 32 38 38 32 66 111 114 100 101 114 32 115 105 122 101 34 59) '(58 116 101 120 116 32 123 108 97 98 101 108 61 34 83 121 109 98 111 108 32 67 111 108 111 114 34 59 125 58 105 109 97 103 101 95 98 117 116 116 111 110 32 123 119 105 100 116 104 61 54 59 107 101 121 61 34 105 98 95 115 121 109 98 111 108 95 99 111 108 111 114 34 59 125 58 116 101 120 116 32 123 108 97 98 101 108 61 34 76 105 110 101 32 67 111 108 111 114 34 59 125 58 105 109 97 103 101 95 98 117 116 116 111 110 32 123 119 105 100 116 104 61 54 59 107 101 121 61 34 105 98 95 108 105 110 101 95 99 111 108 111 114 34 59 125) '(58 116 101 120 116 32 123 108 97 98 101 108 61 34 84 101 120 116 32 67 111 108 111 114 34 59 125 58 105 109 97 103 101 95 98 117 116 116 111 110 32 123 119 105 100 116 104 61 54 59 107 101 121 61 34 105 98 95 116 101 120 116 95 99 111 108 111 114 34 59 125 115 112 97 99 101 114 59 58 116 101 120 116 32 123 108 97 98 101 108 61 34 66 111 114 100 101 114 32 83 105 122 101 34 59 125) '(58 99 111 108 117 109 110 32 123 58 112 111 112 117 112 95 108 105 115 116 32 123 119 105 100 116 104 61 50 52 59 107 101 121 61 34 112 108 95 83 76 68 95 98 111 114 100 101 114 95 115 105 122 101 34 59 118 97 108 117 101 61 34 51 34 59 125 58 105 109 97 103 101 32 123 104 101 105 103 104 116 61 48 46 53 59 99 111 108 111 114 61 100 105 97 108 111 103 95 98 97 99 107 103 114 111 117 110 100 59 125 125 125 115 112 97 99 101 114 59 115 112 97 99 101 114 59) '(58 98 111 120 101 100 95 99 111 108 117 109 110 32 123 108 97 98 101 108 61 34 80 114 105 110 116 101 114 32 38 38 32 80 97 112 101 114 32 83 101 116 116 105 110 103 115 34 59 58 114 111 119 32 123 58 99 111 108 117 109 110 32 123 108 97 98 101 108 61 34 80 108 111 116 32 68 101 118 105 99 101 115 34 59 32 58 112 111 112 117 112 95 108 105 115 116 32 123 107 101 121 61 34 112 108 95 112 108 111 116 95 100 101 118 105 99 101 115 34 59 32 118 97 108 117 101 61 34 48 34 59 125 115 112 97 99 101 114 59 125) '(58 99 111 108 117 109 110 32 123 108 97 98 101 108 61 34 80 97 112 101 114 32 83 105 122 101 115 34 59 32 58 112 111 112 117 112 95 108 105 115 116 32 123 107 101 121 61 34 112 108 95 112 97 112 101 114 95 115 105 122 101 115 34 59 32 118 97 108 117 101 61 34 48 34 59 125 115 112 97 99 101 114 59 125) '(58 99 111 108 117 109 110 32 123 108 97 98 101 108 61 34 80 108 111 116 32 83 116 121 108 101 115 34 59 32 58 112 111 112 117 112 95 108 105 115 116 32 123 107 101 121 61 34 112 108 95 112 108 111 116 95 115 116 121 108 101 115 34 59 32 118 97 108 117 101 61 34 48 34 59 125 115 112 97 99 101 114 59 125) '(58 99 111 108 117 109 110 32 123 108 97 98 101 108 61 34 80 108 111 116 32 82 97 110 103 101 34 59 32 58 112 111 112 117 112 95 108 105 115 116 32 123 107 101 121 61 34 112 108 95 112 108 111 116 95 114 97 110 103 101 34 59 32 118 97 108 117 101 61 34 48 34 59 125 115 112 97 99 101 114 59 125 125) '(58 114 111 119 32 123 58 116 111 103 103 108 101 32 123 108 97 98 101 108 61 34 80 114 105 110 116 32 101 97 99 104 32 100 105 97 103 114 97 109 34 59 107 101 121 61 34 116 103 95 112 114 105 110 116 95 101 97 99 104 95 100 105 97 103 114 97 109 34 59 125 58 116 111 103 103 108 101 32 123 108 97 98 101 108 61 34 80 117 98 108 105 115 104 34 59 107 101 121 61 34 116 103 95 112 117 98 108 105 115 104 34 59 125 125 125) '(115 112 97 99 101 114 59 115 112 97 99 101 114 59 58 114 111 119 32 123 103 97 112 59 58 105 109 97 103 101 32 123 104 101 105 103 104 116 61 48 46 49 59 99 111 108 111 114 61 50 53 51 59 125 103 97 112 59 125 115 112 97 99 101 114 59 115 112 97 99 101 114 59 115 112 97 99 101 114 59 111 107 95 99 97 110 99 101 108 59 125) '(103 97 112 58 105 109 97 103 101 32 123 102 105 120 101 100 95 119 105 100 116 104 61 116 114 117 101 59 119 105 100 116 104 61 49 59 99 111 108 111 114 61 100 105 97 108 111 103 95 98 97 99 107 103 114 111 117 110 100 59 125) ' (115 116 105 99 107 58 105 109 97 103 101 32 123 102 105 120 101 100 95 104 101 105 103 104 116 61 116 114 117 101 59 104 101 105 103 104 116 61 48 46 48 49 59 102 105 120 101 100 95 119 105 100 116 104 61 116 114 117 101 59 119 105 100 116 104 61 48 46 49 59 99 111 108 111 114 61 100 105 97 108 111 103 95 98 97 99 107 103 114 111 117 110 100 59 125) '(118 108 105 110 101 58 99 111 108 117 109 110 32 123 115 116 105 99 107 59 58 105 109 97 103 101 32 123 102 105 120 101 100 95 119 105 100 116 104 61 116 114 117 101 59 119 105 100 116 104 61 48 46 49 59 99 111 108 111 114 61 50 53 51 59 125 115 116 105 99 107 59 125) )) (if (and (setq main-dialog-fn (vl-filename-mktemp "Main.dcl")) (setq main-dialog-fp (open main-dialog-fn "w"))) (mapcar '(lambda (x)(write-line (vl-list->string x) main-dialog-fp)) lst)) (if main-dialog-fp (close main-dialog-fp))(gc)) (defun SLD_Main_Dialog_Action () (mapcar '(lambda (x)(action_tile (car x) (cadr x))) '(("cancel" "(done_dialog 0)") ("accept" "(done_dialog 1)")("eb_SLD_data_source_filename" "(setq #SLD-data-Source-Filename $value)") ("bt_SLD_select_data_source_filename" "(SLD_Select_Data_Source_Filename)")("bt_SLD_open_csv_with_excel" "(shell_open #SLD-data-Source-Filename)") ("bt_SLD_open_csv_with_notepad" "(startapp \"Notepad\" #SLD-data-Source-Filename)")("eb_SLD_symbol_source_folder" "(setq #SLD-Symbol-Source-Folder $value)") ("bt_SLD_select_symbol_source_folder" "(SLD_Select_Symbol_Source_Folder)")("eb_SLD_drawing_output_folder" "(setq #SLD-Drawing-Output-Folder $value)") ("bt_SLD_select_drawing_output_folder" "(SLD_Select_Drawing_Output_Folder)")("eb_SLD_max_nof_columns" "(setq #SLD-MaxNofColumns $value)") ("eb_SLD_column_distance" "(setq #SLD-ColumnDistance $value)")("eb_SLD_max_nof_rows""(setq #SLD-MaxNofRows $value)") ("eb_SLD_row_distance" "(setq #SLD-RowDistance $value)")("pl_SLD_border_size""(setq #SLD-BorderSize $value)") ("eb_x_coord""(setq #SLD-Start-Point-X $value)")("eb_y_coord""(setq #SLD-Start-Point-y $value)")("bt_select_start_point" "(done_dialog 2)") ("ib_symbol_color""(SLD_Select_Symbol_Color)")("ib_line_color" "(SLD_Select_Line_Color)")("ib_text_color" "(SLD_Select_Text_Color)") ("pl_plot_devices""(SLD_Select_Printer $value)")("pl_paper_sizes""(SLD_Select_Paper_Size $value)")("pl_plot_styles""(SLD_Select_Plot_Style $value)") ("pl_plot_range""(SLD_Select_Plot_Range $value)")("tg_print_each_diagram""(setq #SLD-Print-Each-Diagram $value)")("tg_publish""(setq #SLD-Publish $value)") ) ) ) (defun SLD_Main_Dialog_Start ( / drv ) (setq main-dialog-fn nil)(if (null main-dialog-fn)(SLD_Main_Dialog_Create))(if (null SLD-PlotInitialized)(SLD_Init_Plot_Settings)) (if (and (setq main-dialog-dcl (load_dialog main-dialog-fn)) (new_dialog "SLD" main-dialog-dcl)) (progn (SLD_Main_Dialog_Update)(SLD_Main_Dialog_Action)(setq drv (start_dialog))(cond((= drv 0)(Main_Dialog_Cancel))((= drv 1) (WriteSettingsToRegistry)(SLD_DoIt))((= drv 2)(WriteSettingsToRegistry)(SLD_Select_Start_Point))))) (if main-dialog-fn (vl-file-delete main-dialog-fn))(setq main-dialog-fn nil)) (defun SLD_Main_Dialog_Update ( / ) (setq MainDialog-tl '((#SLD-data-Source-Filename "eb_SLD_data_source_filename")(#SLD-Symbol-Source-Folder "eb_SLD_symbol_source_folder") (#SLD-Drawing-Output-Folder "eb_SLD_drawing_output_folder")(#SLD-MaxNofColumns "eb_SLD_max_nof_columns")(#SLD-ColumnDistance "eb_SLD_column_distance") (#SLD-MaxNofRows "eb_SLD_max_nof_rows")(#SLD-RowDistance "eb_SLD_row_distance")(#SLD-BorderSize "pl_SLD_border_size")(#SLD-Start-Point-X "eb_x_coord") (#SLD-Start-Point-y "eb_y_coord")(#SLD-Print-Each-Diagram "tg_print_each_diagram")(#SLD-Publish "tg_publish"))) (if (null MainDialog-rd) (setq MainDialog-rd (Save_Dialog_Data MainDialog-tl)))(Set_Dialog_Tiles MainDialog-tl)(start_list "pl_SLD_border_size") (mapcar 'add_list '("A0" "A1" "A2" "A3" "A4")) (end_list)(set_tile "pl_SLD_border_size" #SLD-BorderSize)(SLD_SetColorImage "ib_line_color" #SLD-Line-Color) (SLD_SetColorImage "ib_symbol_color" #SLD-Symbol-Color)(SLD_SetColorImage "ib_text_color" #SLD-Text-Color)(SLD_Update_Plot_Settings)) (defun SLD_Select_Start_Point ( / pt)(if (setq pt (getpoint "\nSelect Start Point : "))(progn (set_tile "eb_x_coord" (setq #SLD-Start-Point-X (rtos (car pt) 2 2)))(set_tile "eb_y_coord" (setq #SLD-Start-Point-Y (rtos (cadr pt) 2 2)))(WriteSettingsToRegistry)))(SLD_Main_Dialog_Start)) (defun SLD_Select_Line_Color ( / col )(if (setq col (acad_colordlg 7 t)) (progn (setq #SLD-Line-Color (itoa col))(WriteSettingsToRegistry)(SLD_SetColorImage "ib_line_color" col)))) (defun SLD_Select_Symbol_Color ( / col )(if (setq col (acad_colordlg 7 t)) (progn (setq #SLD-Symbol-Color (itoa col))(WriteSettingsToRegistry)(SLD_SetColorImage "ib_symbol_color" col)))) (defun SLD_Select_Text_Color ( / col )(if (setq col (acad_colordlg 7 t)) (progn (setq #SLD-Text-Color (itoa col))(WriteSettingsToRegistry)(SLD_SetColorImage "ib_text_color" col)))) (defun SLD_SetColorImage (im c / col x y ) (if (isnum c) (cond ((= (type c) 'STR)(setq col (atoi c)))((= (type c) 'INT)(setq col c))(t (setq col nil)))) (cond ((= c "bylayer")(setq col 256)) ((= c "byblock")(setq col 0))) (if col (progn (setq x (dimx_tile im) y (dimy_tile im))(start_image im)(fill_image 0 0 x y col)(end_image))) ) (defun SLD_Read_Data_Source_file ( fn / fp header *dl* data lst new-dwg dwg-record) (cond ((void fn)(alert "Computer says no : CSV filename invalid"))((not (findfile fn)) (alert "Computer says no : CSV file missing")) ((not (setq fp (open fn "r"))) (alert "Computer says no : unable to read from CSV file")) (t (setq header (read-line fp))(setq *dl* "," new-dwg nil) (while (setq data (read-line fp))(setq data (vl-list->string (vl-remove 59 (vl-string->list data))))(cond ((eq (vl-string-trim "," data) "") (setq dwg-record (append dwg-record (list data)) lst (append lst (list dwg-record)) dwg-record nil))(t (setq dwg-record (append dwg-record (list data)))))) (setq lst (append lst (list dwg-record)))(close fp))) lst) (defun SLD_Select_Data_Source_Filename ( / d f l) (if (not (void #SLD-data-Source-Filename))(setq d (strcat (vl-filename-directory #SLD-data-Source-Filename) "\\"))(setq d (getvar "SAVEFILEPATH"))) (if (setq f (getfiled "Select Data Source File (csv)" d "csv" 16))(progn (set_tile "eb_SLD_data_source_filename" (setq #SLD-data-Source-Filename f)) (WriteSettingsToRegistry)(if (vl-consp (setq l (SLD_Read_Data_Source_file f)))(setq csv-data-list l)(alert "no data found in data file"))))) (defun SLD_Preload_Data_Source_File ()(if (and (not (void #SLD-data-Source-Filename)) (findfile #SLD-data-Source-Filename)) (setq csv-data-list (SLD_Read_Data_Source_file #SLD-data-Source-Filename))(princ "\nIO data list not yet initialized"))) (defun SLD_Select_Symbol_Source_Folder ( / f )(if (setq f (GetShellFolder "Select Symbol Source Folder")) (progn (set_tile "eb_SLD_symbol_source_folder" (setq #SLD-Symbol-Source-Folder (vl-string-right-trim "\\/" f)))(WriteSettingsToRegistry)))) (defun SLD_Select_Drawing_Output_Folder ( / f )(if (setq f (GetShellFolder "Select Drawing Output Folder")) (progn (set_tile "eb_SLD_drawing_output_folder" (setq #SLD-Drawing-Output-Folder (vl-string-right-trim "\\/" f)))(WriteSettingsToRegistry)))) (defun SLD_DoIt ( / dwg-number start-point current-row current-col current-direction symbol-half-width begin-point new-insertion-point block-list titleblock sym-tag sym-des sym-dist sym-des2 ring-info-list bobj l-dwg-record line-count l) (cond ((void #SLD-Drawing-Output-Folder) (alert "Please select output folder for your drawings")) ((void #SLD-Symbol-Source-Folder) (alert "Please select folder for your symbols")) ((void csv-data-list) (alert "No data found in data list")) (t (if (void #SLD-BorderSize)(setq #SLD-BorderSize "3")) (draw_border (atoi #SLD-BorderSize))(vla-ZoomExtents (vlax-get-acad-object)) (setq dwg-number 1) (if (and (isnum #SLD-Start-Point-X)(isnum #SLD-Start-Point-Y)) (setq start-point (list (atof #SLD-Start-Point-X) (atof #SLD-Start-Point-Y))) (setq start-point (list 40 250)) ) (setq symbol-half-width 15) (foreach dwg-record csv-data-list (vl_delete_everything) (if (setq bobj (Insert_Block (nth (atoi #SLD-BorderSize) '("A0" "A1" "A2" "A3" "A4")) (list 0 0)))(setq titleblock (entlast))) (vla-ZoomExtents (vlax-get-acad-object))(setq new-insertion-point start-point current-row 1 current-col 1 current-direction 0 block-list nil ring-info-list nil) (setq l (mapcar 'de-commatize dwg-record) dwg-record-summary (mapcar '(lambda (x) (nth 6 (nth x l))) '(0 1 2 4 5 6 7 8))) (if (vl-consp dwg-record)(setq l-dwg-record (length dwg-record) line-count 1))(setq dwg-record (vl-remove "" dwg-record)) (while (vl-consp dwg-record) (setq sym-record (Splitstr (car dwg-record) ","))(setq sym-tag (nth 0 sym-record) sym-des (nth 1 sym-record) sym-dist (nth 2 sym-record)) (setq sym-des2 (nth 3 sym-record) ring-info-list (append ring-info-list (list (cons (nth 5 sym-record) (nth 6 sym-record))))) (cond ((or (wcmatch (strcase sym-des) "*POP*") (wcmatch (strcase sym-des) "*POP*")) (setq sym-des (StrRemove sym-des (list " POP" "-POP"))) (if (setq blk (Insert_Block "POP" new-insertion-point)) (progn (setq block-list (append block-list (list blk)))(wai blk "DESCRIPTION" sym-des)(wai blk "number" sym-des2) (if (= current-direction 0) (wai blk "DIST-PL" sym-dist) (wai blk "DIST-NL" sym-dist)))) (setq dwg-record (cdr dwg-record))(setq new-insertion-point (next_point))) ((wcmatch (strcase sym-tag) "GP*")(setq sym-des (StrRemove sym-des (list " GP" "-GP"))) (if (setq blk (Insert_Block "GP" new-insertion-point)) (progn (setq block-list (append block-list (list blk))) (wai blk "DESCRIPTION1" sym-des)(wai blk "DESCRIPTION2" sym-des2) (wai blk "GP" sym-tag)(if (= current-direction 0) (wai blk "DIST-PL" sym-dist) (wai blk "DIST-NL" sym-dist)))) (setq dwg-record (cdr dwg-record))(setq new-insertion-point (next_point))) ((wcmatch (strcase sym-tag) "CLAMP*")(process_clamp)(setq dwg-record (cdr dwg-record))(setq new-insertion-point (next_point))) ((wcmatch (strcase sym-tag) "BJC-U")(process_BJC-U)(setq dwg-record (cdr dwg-record))(setq new-insertion-point (next_point))) ((wcmatch (strcase sym-tag) "4 WAY BJC")(process_4_WAY_BJC)(setq dwg-record (cdr dwg-record))(setq new-insertion-point (next_point))) (t (> i l-dwg-record) (alert "Unknown symbol in data - exit")(exit)))(setq line-count (1+ line-count)))(Connect_Symbols)(Update_Clamps) (update_titleblock titleblock dwg-record-summary)(save_drawing)(if (eq #SLD-Print-Each-Diagram "1")(cond ((wcmatch (strcase #SLD-LastPlotDevice t) "*pdf*") (plot_pdf))(t (plot_other))))(setq dwg-number (1+ dwg-number))))) ) (defun process_clamp ( / clamp-record done l tmp-record) (setq clamp-record (cons sym-record clamp-record) done nil) (while (and (vl-consp dwg-record) (not done)) (setq dwg-record (cdr dwg-record))(setq sym-record (de-commatize (car dwg-record))) (setq clamp-record (cons sym-record clamp-record))(if (wcmatch (strcase (car sym-record)) "CLAMP*")(setq done T))) (setq clamp-record (reverse clamp-record) l (length clamp-record))(setq clamp-record (vl-remove "" clamp-record)) (cond ((not l)) ((eq l 3) (cond ((and (wcmatch (strcase (nth 0 (nth 1 clamp-record))) "GP*")(setq blk (Insert_Block "Clamp" new-insertion-point))) (setq block-list (append block-list (list blk))) (if (= current-direction 0) (wai blk "DIST-PL" sym-dist) (wai blk "DIST-NL" sym-dist)) (setq tmp-record (nth 1 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record)) (setq sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (setq sym-des (StrRemove sym-des (list " GP" "-GP")))(wai blk "DESCRIPTION1" sym-des)(wai blk "DESCRIPTION2" sym-des2) (wai blk "GP" sym-tag)(wai blk "DIST-CLAMP-BGP" sym-dist)(setq tmp-record (nth 2 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record)) (setq sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (if (= current-direction 0) (wai blk "DIST-NL" sym-dist) (wai blk "DIST-PL" sym-dist))) ((and (wcmatch (strcase (nth 0 (nth 1 clamp-record))) "POP")(setq blk (Insert_Block "Clamp-pop" new-insertion-point))) (setq block-list (append block-list (list blk))) (if (= current-direction 0) (wai blk "DIST-PL" (strcat (StrRemove (nth 2 (nth 0 clamp-record)) (list " km" " KM")) " KM")) (wai blk "DIST-NL" (strcat (StrRemove (nth 2 (nth 0 clamp-record)) (list " km" " KM")) " KM"))) (wai blk "DIST-POP-NL" (strcat (StrRemove (nth 2 (nth 1 clamp-record)) (list " km" " KM")) " KM")) (wai blk "DESCRIPTION" (StrRemove (nth 1 (nth 1 clamp-record)) (list " POP")))(wai blk "NUMBER" (nth 3 (nth 1 clamp-record))) ) ) ) ((eq l 4) (if (setq blk (Insert_Block "Clamp-2GP" new-insertion-point)) (progn (setq block-list (append block-list (list blk))) (if (= current-direction 0) (wai blk "DIST-PL" sym-dist) (wai blk "DIST-NL" sym-dist)) (setq tmp-record (nth 1 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (setq sym-des (StrRemove sym-des (list " GP" "-GP")))(wai blk "DESCRIPTION1-a" sym-des)(wai blk "DESCRIPTION2-a" sym-des2) (wai blk "GP-a" sym-tag)(wai blk "DIST-CLAMP-GPa" sym-dist)(setq tmp-record (nth 2 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (setq sym-des (StrRemove sym-des (list " GP" "-GP")))(wai blk "DESCRIPTION1-b" sym-des)(wai blk "DESCRIPTION2-b" sym-des2) (wai blk "GP-b" sym-tag)(wai blk "DIST-GPa-GPb" sym-dist)(setq tmp-record (nth 3 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (if (= current-direction 0) (wai blk "DIST-NL" sym-dist) (wai blk "DIST-PL" sym-dist)) ) ) ) ((eq l 7) (if (setq blk (Insert_Block "BJC-D" new-insertion-point)) (progn (setq block-list (append block-list (list blk))) (if (= current-direction 0) (wai blk "DIST-PL" sym-dist) (wai blk "DIST-NL" sym-dist)) (wai blk "DIST-1" (strcat (StrRemove (nth 2 (nth 1 clamp-record)) (list " km" " KM")) " KM")) (wai blk "DIST-2" (strcat (StrRemove (nth 2 (nth 2 clamp-record)) (list " km" " KM")) " KM")) (wai blk "DIST-3" (strcat (StrRemove (nth 2 (nth 4 clamp-record)) (list " km" " KM")) " KM")) (wai blk "DESCRIPTION1-a" (StrRemove (nth 1 (nth 2 clamp-record)) (list " gp" " GP"))) (wai blk "DESCRIPTION2-a" (nth 3 (nth 2 clamp-record)))(wai blk "GP-a" (nth 0 (nth 2 clamp-record))) (wai blk "DESCRIPTION1-b" (StrRemove (nth 1 (nth 4 clamp-record)) (list " gp" " GP"))) (wai blk "DESCRIPTION2-b" (nth 3 (nth 4 clamp-record)))(wai blk "GP-b" (nth 0 (nth 4 clamp-record)))) (princ "\nUnable to insert block : BJC-D")))(t (princ "Unknown clamp detected")))(princ)) (defun process_BJC-U ( / clamp-record done l tmp-record) (setq clamp-record (cons sym-record clamp-record) done nil) (repeat 5 (setq dwg-record (cdr dwg-record))(setq sym-record (de-commatize (car dwg-record)))(setq clamp-record (cons sym-record clamp-record)) (if (wcmatch (strcase (car sym-record)) "BJC-U")(setq done T))) (setq clamp-record (reverse clamp-record) l (length clamp-record))(setq clamp-record (vl-remove "" clamp-record)) (if (setq blk (Insert_Block "BJC-U" new-insertion-point)) (progn (setq block-list (append block-list (list blk))) (if (= current-direction 0) (wai blk "DIST-PL" sym-dist) (wai blk "DIST-NL" sym-dist)) (setq tmp-record (nth 1 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (wai blk "DIST-1" sym-dist) (setq tmp-record (nth 2 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (wai blk "DESCRIPTION1-a" sym-des) (wai blk "DESCRIPTION2-a" sym-des2) (wai blk "GP-a" sym-tag) (wai blk "DIST-2" sym-dist) (setq tmp-record (nth 3 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (setq tmp-record (nth 4 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (setq sym-tag (StrRemove sym-tag (list "SPUR-"))) (setq sym-des (StrRemove sym-des (list " GP-SL"))) (wai blk "DESCRIPTION1-b" sym-des) (wai blk "DESCRIPTION2-b" sym-des2) (wai blk "GP-b" sym-tag) (wai blk "DIST-3" sym-dist) (setq tmp-record (nth 5 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) ) ) (princ) ) (defun process_4_WAY_BJC ( / clamp-record done tmp-record) (setq clamp-record (cons sym-record clamp-record) done nil) (repeat 4 (setq dwg-record (cdr dwg-record)) (setq sym-record (de-commatize (car dwg-record))) (setq clamp-record (cons sym-record clamp-record)) (if (wcmatch (strcase (car sym-record)) "BJC-U")(setq done T)) ) (setq clamp-record (reverse clamp-record)) (setq clamp-record (vl-remove "" clamp-record)) (cond ((and (wcmatch (strcase (nth 0 (nth 1 clamp-record))) "POP-U") (wcmatch (strcase (nth 0 (nth 3 clamp-record))) "GP*") (setq blk (Insert_Block "BJC-4WAY-POP-GP" new-insertion-point))) (setq block-list (append block-list (list blk))) (if (= current-direction 0) (wai blk "DIST-PL" (strcat (StrRemove (nth 2 (nth 0 clamp-record)) (list " km" " KM")) " KM")) (wai blk "DIST-NL" (strcat (StrRemove (nth 2 (nth 0 clamp-record)) (list " km" " KM")) " KM")) ) (wai blk "DIST-CLAMP-POP" (strcat (StrRemove (nth 2 (nth 1 clamp-record)) (list " km" " KM")) " KM")) (wai blk "DESCRIPTION" (StrRemove (nth 1 (nth 1 clamp-record)) (list " POP-U"))) (wai blk "NUMBER" (nth 3 (nth 1 clamp-record))) (wai blk "DIST-CLAMP-GP" (strcat (StrRemove (nth 2 (nth 3 clamp-record)) (list " km" " KM")) " KM")) (wai blk "DESCRIPTION1-b" (StrRemove (nth 1 (nth 3 clamp-record)) (list " GP"))) (wai blk "DESCRIPTION2-b" (nth 3 (nth 3 clamp-record))) (wai blk "GP" (nth 0 (nth 3 clamp-record))) ) ((and (wcmatch (strcase (nth 0 (nth 1 clamp-record))) "GP*") (wcmatch (strcase (nth 0 (nth 3 clamp-record))) "GP*") (setq blk (Insert_Block "BJC-4WAY" new-insertion-point))) (setq block-list (append block-list (list blk))) (if (= current-direction 0) (wai blk "DIST-PL" sym-dist) (wai blk "DIST-NL" sym-dist)) (setq tmp-record (nth 1 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (setq sym-des (StrRemove sym-des (list " GP" "-GP"))) (wai blk "DESCRIPTION1-a" sym-des) (wai blk "DESCRIPTION2-a" sym-des2) (wai blk "GP-a" sym-tag) (wai blk "DIST-CLAMP-GPa" sym-dist) (setq tmp-record (nth 2 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (setq sym-des (StrRemove sym-des (list " GP" "-GP"))) (wai blk "DESCRIPTION1-b" sym-des) (wai blk "DESCRIPTION2-b" sym-des2) (wai blk "GP-b" sym-tag) (wai blk "DIST-GPa-GPb" sym-dist) (setq tmp-record (nth 3 clamp-record)) (setq sym-tag (nth 0 tmp-record) sym-des (nth 1 tmp-record) sym-dist (nth 2 tmp-record) sym-des2 (nth 3 tmp-record) ring-info-list (append ring-info-list (list (cons (nth 5 tmp-record) (nth 6 tmp-record))))) (if (= current-direction 0) (wai blk "DIST-NL" sym-dist) (wai blk "DIST-PL" sym-dist)) ) ) ) (defun Connect_Symbols ( / old-col i blk b1 ip1 b2 ip2 ang pt1 pt2 pt3 pt4) (setq old-col (getvar 'CECOLOR)) (vl-catch-all-apply 'setvar (list 'CECOLOR #SLD-Line-Color)) (if (vl-consp block-list) (progn (setq i 0 l (length block-list)) (foreach blk block-list (setq b1 (nth i block-list) b2 (nth (1+ i) block-list)) lst (cond ((and b1 b2) (setq ip1 (getip b1) ip2 (getip b2) ang (angle ip1 ip2)) (cond ((equal ang 0) (setq pt1 (list (+ (car ip1) symbol-half-width) (cadr ip1)) pt2 (list (- (car ip2) symbol-half-width) (cadr ip2))) (_AddLines (list pt1 pt2)) ) ((equal ang pi) (setq pt1 (list (- (car ip1) symbol-half-width) (cadr ip1)) pt2 (list (+ (car ip2) symbol-half-width) (cadr ip2))) (_AddLines (list pt1 pt2)) ) ((and (equal ang (* pi 1.5)) (= pi (angle ip1 (getip (nth (1- i) block-list))))) (setq pt1 (list (+ (car ip1) symbol-half-width) (cadr ip1)) pt2 (list (+ (car ip1) (atoi #SLD-ColumnDistance)) (cadr ip1)) pt3 (list (+ (car ip2) (atoi #SLD-ColumnDistance)) (cadr ip2)) pt4 (list (+ (car ip2) symbol-half-width) (cadr ip2))) (_AddLines (list pt1 pt2 pt3 pt4)) ) ((and (equal ang (* pi 1.5)) (equal 0 (angle ip1 (getip (nth (1- i) block-list))))) (setq pt1 (list (- (car ip1) symbol-half-width) (cadr ip1)) pt2 (list (- (car ip1) (atoi #SLD-ColumnDistance)) (cadr ip1)) pt3 (list (- (car ip2) (atoi #SLD-ColumnDistance)) (cadr ip2)) pt4 (list (- (car ip2) symbol-half-width) (cadr ip2))) (_AddLines (list pt1 pt2 pt3 pt4)) ) ) ) ) (setq i (1+ i)) ) (princ "\nBlocks connected") ) (princ "\nUnable to connect blocks") ) (setvar 'CECOLOR old-col) ) (defun _AddLines ( l / s) (setq m (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (while (> (length l) 1)(vla-AddLine m (vlax-3d-point (car l))(vlax-3d-point (cadr l)))(setq l (cdr l)))) (defun Update_Clamps ( / i l blk ang next-blk ) (if (vl-consp block-list) (progn (setq i -1 l (length block-list)) (foreach blk block-list (setq i (1+ i)) (if (and (> i 0) (< i l) (setq next-blk (nth (1+ i) block-list))) (setq ang (angle (getip blk) (getip next-blk))) (setq ang nil)) (if (and (setq bn (block-n blk)) (wcmatch (strcase bn t) "clamp*")) (cond ((and (not (void (setq dist-1 (tai blk "DIST-CLAMP-BGP")))) (not (void (setq dist-2 (tai blk "DIST-PL"))))) (wai blk "DIST-BGP-PL" (sum_dist dist-1 dist-2))) ((and (equal ang 0) (void (tai blk "DIST-PL")) (not (void (setq dist-1 (tai blk "DIST-CLAMP-BGP")))) (not (void (setq dist-2 (tai (nth (1- i) block-list) "DIST-NL"))))) (wai blk "DIST-BGP-PL" (sum_dist dist-1 dist-2))) ((and (equal ang pi) (void (tai blk "DIST-PL")) (not (void (setq dist-1 (tai blk "DIST-CLAMP-BGP")))) (not (void (setq dist-2 (tai (nth (1+ i) block-list) "DIST-NL"))))) (wai blk "DIST-BGP-PL" (sum_dist dist-1 dist-2))) ((and (equal ang (* pi 1.5)) (void (tai blk "DIST-PL")) (not (void (setq dist-1 (tai blk "DIST-CLAMP-BGP")))) (not (void (setq dist-2 (tai (nth (1- i) block-list) "DIST-NL"))))) (wai blk "DIST-BGP-PL" (sum_dist dist-1 dist-2))) (t (princ "\nNo match found for clamp")) ) ) ) (princ "\nClamps updated") ) (princ "\nUnable to update clamps") ) ) (defun sum_dist (d1 d2) (strcat (rtos (+ (atof (vl-string-trim " KM" (strcase d1))) (atof (vl-string-trim " KM" (strcase d2)))) 2 3) " km")) (defun Clean_Drawing () (vl-cmdf "erase" "all" "")(vla-purgeall (vla-get-activedocument (vlax-get-acad-object)))(gc)) (defun Save_Drawing ( / dwg-name exist-dwg) (cond ((void #SLD-Drawing-Output-Folder) (princ "\nInvalid output folder : unable to save drawing")) ((not (vl-file-directory-p #SLD-Drawing-Output-Folder)) (princ "\nInvalid output folder name : folder doesn't exist")) (t (setq dwg-name (strcat #SLD-Drawing-Output-Folder "\\diagram-" (itoa dwg-number))) (if (findfile (setq exist-dwg (strcat dwg-name ".dwg"))) (progn (vl-file-delete exist-dwg)(gc))) (setvar "expert" 5)(setvar "cmdecho" 0)(setvar "attreq" 0)(setvar "FILEDIA" 0) (cond ((void dwg-name) (alert (strcat "Invalid dwg name : " (vl-princ-to-string dwg-name)))) ((vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-saveas (list ActDoc dwg-name)))) (alert (strcat "Unable to save file\n" (vl-catch-all-error-message err)))) (t (princ (strcat "\nFile saved : " dwg-name))) ) (setvar "expert" 1)(setvar "cmdecho" 1)(setvar "attreq" 1)(setvar "FILEDIA" 1) ) ) (gc)(gc)(gc) ) (defun insert_block ( bn ip / old-col ) (setq old-col (getvar 'CECOLOR)) (vl-catch-all-apply 'setvar (list 'CECOLOR #SLD-Symbol-Color)) (if (vl-catch-all-error-p (setq bo (vl-catch-all-apply'vla-InsertBlock (list ActSpace (vlax-3D-point ip) (findfile (strcat #SLD-Symbol-Source-Folder "\\" bn ".dwg")) 1.0 1.0 1.0 0.0)))) nil (progn (setvar 'CECOLOR old-col) (vlax-vla-object->ename bo)) ) ) (defun next_point ( / pt) (cond ((and (= current-direction 0) (< current-col (atoi #SLD-MaxNofColumns))) (setq current-col (1+ current-col))) ((and (= current-direction 180) (> current-col 1)) (setq current-col (1- current-col))) ((and (= current-direction 0) (= current-col (atoi #SLD-MaxNofColumns))) (setq current-direction 180 current-row (+ current-row 2))) ((and (= current-direction 180) (= current-col 1)) (setq current-row (+ current-row 2) current-direction 0)) ((and (= current-direction 180) (= current-col (atoi #SLD-MaxNofColumns))) (setq current-col (1- current-col))) ) (setq pt (list (+ (car start-point) (* (1- current-col) (atoi #SLD-ColumnDistance))) (- (cadr start-point) (* (1- current-row) (atoi #SLD-RowDistance))))) (princ) pt ) (defun Draw_Border ( n / f) (defun f (p) (vl-cmdf ".pline" '(0 0) (list 0 (cadr p)) p (list (car p) 0) "c")) (f (nth n '((1188 840) (840 594) (594 420) (420 297) (210 297))))) (defun update_titleblock (b l) (if (and b (vl-consp l))(mapcar '(lambda (a v)(wai b a v)) '("Ring-ID""Pop-to-Pop""District-Code""DISTRICT""APPROVED_MANDAL""RING_NUMBER""NO_OF_GP-S""TOTAL_LENGTH") l) (princ "\nUnable to update titleblock"))) (defun analyze (r) (mapcar '(lambda (x) (nth 6 (nth x r))) '(0 1 2 4 5 6 7 8))) (defun _GetPlotDevices () (vla-RefreshPlotDeviceInfo ActLay) (cdr (vlax-safearray->list (vlax-variant-value (vla-getplotdevicenames (vla-item (vla-get-layouts ActDoc) "Model")))))) (defun SLD_GetPlotDevices () (vla-RefreshPlotDeviceInfo ActLay) (cdr (vlax-safearray->list (vlax-variant-value (vla-getplotdevicenames ActLay))))) (defun SLD_GetPaperSizes () (vla-RefreshPlotDeviceInfo ActLay) (if (>= (vlax-safearray-get-u-bound (vlax-variant-value (vla-GetCanonicalMediaNames ActLay)) 1) 0) (vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames ActLay)))(list "none"))) (defun SLD_GetPlotStyles () (vla-RefreshPlotDeviceInfo ActLay) (acad_strlsort (vl-directory-files (SplitPath (getenv "PrinterStyleSheetDir")) (if (= 1 (getvar "PSTYLEMODE")) "*.ctb" "*.stb") 1 ))) (defun SplitPath ($p / l) (if (wcmatch $p "*;*")(car (splitstr $p ";")) $p)) (defun SLD_GetPaperSizesFor ( $prt / old-prt-name l-cano l-loco) (vla-RefreshPlotDeviceInfo ActLay) (if (/= $prt (setq old-prt-name (vla-get-configname ActLay))) (progn (vla-put-configname ActLay $prt) (vla-RefreshPlotDeviceInfo ActLay))) (if (>= (vlax-safearray-get-u-bound (vlax-variant-value (vla-GetCanonicalMediaNames ActLay)) 1) 0) (setq l-cano (vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames ActLay)))) (setq l-cano nil)) (if l-cano (setq l-loco (mapcar '(lambda (x) (if (not (eq x "None")) (vla-GetLocaleMediaName ActLay x) "Nothing")) l-cano))) (if (and old-prt-name (/= (strcase old-prt-name t) "none")) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-configname (list ActLay old-prt-name))) (princ (strcat "\nUnable to use old printer (missing) : " old-prt-name)))) (vla-RefreshPlotDeviceInfo ActLay) l-loco ) (defun deletePageSetup (doc name) (vlax-for pc (vla-get-plotconfigurations doc) (if (= (strcase (vla-get-name pc)) (strcase name)) (vla-delete pc)))) (defun addPageSetup (doc name / space pc lay)(deletePageSetup doc name) (if (= (getvar "ctab") "Model")(setq space :vlax-true lay (vla-get-Layout (vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object))))) (setq space :vlax-false lay (vla-get-ActiveLayout (vla-get-activedocument (vlax-get-acad-object))))) (setq pc (vla-add (vla-get-plotconfigurations doc) name space))(vla-CopyFrom pc lay)(vla-put-name pc name)) (defun SLD_Pagesetup ( / psname pConfigs pItem org avp) (setq psname "SLD") (addPageSetup actDoc psname) (setq pConfigs (vla-get-plotconfigurations actDoc) pItem (vl-catch-all-apply 'vla-Item (list pConfigs psname))) (vla-refreshplotdeviceInfo pItem) (vla-put-configname pItem #SLD-LastPlotDevice) (vla-put-canonicalmedianame pItem (vl-string-translate " " "_" #SLD-LastPaperSize)) (vla-put-paperunits pItem acMillimeters) (vla-put-PlotType pItem (nth (vl-position #SLD-LastPlotRange SLD-PlotRange) (list acDisplay acExtents acLimits))) (vlax-safearray-fill (setq org (vlax-make-safearray vlax-vbDouble '(0 . 1))) (list 0.0 0.0)) (vla-put-PlotOrigin pItem org) (if (= :vlax-false (vla-get-CenterPlot pItem)) (vla-put-CenterPlot pItem :vlax-true)) (vla-put-UseStandardScale pItem :vlax-true) (vla-put-StandardScale pItem acScaleToFit) (vla-put-PlotHidden pItem :vlax-false) (vla-put-PlotWithPlotStyles pItem :vlax-true) (vla-put-StyleSheet pItem #SLD-LastPlotStyle) (vla-put-PlotRotation pItem ac0degrees) (vla-put-PlotViewportBorders pItem :vlax-true) (vla-put-PlotViewportsFirst pItem :vlax-true) (vla-put-PlotWithLineweights pItem :vlax-true) (vla-put-ScaleLineweights pItem :vlax-true) (if (= (getvar "TILEMODE") 1)(setq avp (vl-catch-all-apply 'vla-get-ActiveViewport (list actDoc))) (setq avp (vl-catch-all-apply 'vla-get-activepviewport (list actDoc)))) (vl-catch-all-apply 'vla-put-ShadePlot (list avp acShadePlotAsDisplayed)) (vla-put-ShowPlotStyles pItem :vlax-false) (vla-CopyFrom (vla-get-ActiveLayout (vla-get-activedocument (vlax-get-acad-object))) pItem) (vla-refreshplotdeviceInfo pItem) ) (defun SLD_Init_Plot_Settings ()(if (null SLD-PlotInitialized)(progn (setq SLD-PlotInitialized t SLD-PlotDevices (SLD_GetPlotDevices)) (if (and (not (void #SLD-LastPlotDevice)) (not (void SLD-PlotDevices))(member #SLD-LastPlotDevice SLD-PlotDevices)) (setq SLD-Papersizes (SLD_GetPaperSizesFor #SLD-LastPlotDevice))(setq SLD-Papersizes (SLD_Getpapersizes))) (setq SLD-PlotStyles (SLD_GetPlotStyles) SLD-PlotRange '("Display" "Extents" "Limits"))))) (defun SLD_Update_Plot_Settings ()(mapcar '(lambda (x) (start_list (car x))(mapcar 'add_list (cdr x))(end_list)) (list (cons "pl_plot_devices" SLD-PlotDevices)(cons "pl_paper_sizes" SLD-Papersizes)(cons "pl_plot_styles" SLD-PlotStyles)(cons "pl_plot_range" SLD-PlotRange))) (mapcar '(lambda (x y z / i)(if (or (void (vl-symbol-value x)) (not (setq i (vl-position (vl-symbol-value x) y)))) (set (read (vl-symbol-name x)) (nth (setq i 0) y)))(set_tile z (itoa i))) (list '#SLD-LastPlotDevice '#SLD-LastPaperSize '#SLD-LastPlotStyle '#SLD-LastPlotRange) (list SLD-PlotDevices SLD-Papersizes SLD-PlotStyles SLD-PlotRange) (list "pl_plot_devices" "pl_paper_sizes" "pl_plot_styles" "pl_plot_range"))) (defun SLD_Select_Printer ($v)(if (and (not (void (setq #SLD-LastPlotDevice (nth (atoi $v) SLD-PlotDevices)))) (not (void (setq SLD-Papersizes (SLD_GetPaperSizesFor #SLD-LastPlotDevice)))))(progn (start_list "pl_paper_sizes") (mapcar 'add_list SLD-Papersizes)(end_list)(if (or (void #SLD-LastPaperSize)(not (member #SLD-LastPaperSize SLD-Papersizes))) (if (not (void SLD-Papersizes))(setq #SLD-LastPaperSize (car SLD-Papersizes))))(set_tile "pl_paper_sizes" #SLD-LastPaperSize)))) (defun SLD_Select_Paper_Size ($v) (setq #SLD-LastPaperSize (nth (atoi $v) SLD-Papersizes))) (defun SLD_Select_Plot_Style ($v) (setq #SLD-LastPlotStyle (nth (atoi $v) SLD-PlotStyles))) (defun SLD_Select_Plot_Range ($v) (setq #SLD-LastPlotRange (nth (atoi $v) SLD-PlotRange))) (defun plot_drawing ( / ActPlot plotFileName) (setq ActPlot (vla-get-Plot ActDoc)) (setq plotFileName (strcat #SLD-Drawing-Output-Folder "\\diagram-" (itoa dwg-number) ".pdf")) (if (wcmatch (strcase #SLD-LastPlotDevice t) "*pdf*") (vla-PlotToFile ActPlot plotFileName) (vla-PlotToDevice ActPlot)) ) (defun plot_pdf ( / prtname papsize orient plotupsidedown p1 p2 pstname ) (setq prtname #SLD-LastPlotDevice) (setq papsize #SLD-LastPaperSize) (setq orient "landscape") (setq plotupsidedown "no") (setq p1 (getvar 'extmin) p2 (getvar 'extmax)) (setq pstname #SLD-LastPlotStyle) (setq pdf-name (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")))) (command ".-Plot" "Yes" "" prtname papsize "Millimeters" orient plotupsidedown "WINDOW" P1 P2 "Fit" "Center" "Yes" pstname "Yes" "As displayed" pdf-name"Yes" "Yes" )(command ".qsave")) (defun plot_other ( / prtname papsize orient plotupsidedown p1 p2 pstname ) (setq prtname #SLD-LastPlotDevice) (setq papsize #SLD-LastPaperSize) (setq orient "landscape") (setq plotupsidedown "no") (setq p1 (getvar 'extmin) p2 (getvar 'extmax)) (setq pstname #SLD-LastPlotStyle) (setq pdf-name (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")))) (command ".-Plot" "Yes" "" prtname papsize "Millimeters" orient plotupsidedown "WINDOW" P1 P2 "Fit" "Center" "Yes" pstname "Yes" "As displayed" "n" "yes" "Yes")) (defun _publish ( / dwg-list dsd-fn dsd-fn tab-lst pdf-path pdf-fn d old-filedia) (setq dwg-list (vl-directory-files (setq d (dos_path #SLD-Drawing-Output-Folder)) "*.dwg")) (setq dsd-fn (strcat d "Single-Lines.dsd") dsd-fp (open dsd-fn "w")) (mapcar '(lambda (s) (write-line s dsd-fp)) '("[DWF6Version]" "Ver=1" "[DWF6MinorVersion]" "MinorVer=1")) (foreach dwg (mapcar '(lambda (x)(strcat d x)) dwg-list) (foreach tab (setq tab-lst '("Model")) (write-line (strcat "[DWF6Sheet:" (vl-filename-base dwg) "_" tab "]") dsd-fp) (write-line (strcat "DWG=" dwg) dsd-fp)(write-line (strcat "Layout=" tab) dsd-fp)(write-line "Setup=" dsd-fp) (write-line (strcat "OriginalSheetPath=" dwg) dsd-fp)(write-line "Has Plot Port=0" dsd-fp)(write-line "Has3DDWF=0" dsd-fp))) (setq pdf-path (dos_path #SLD-Drawing-Output-Folder) pdf-fn (strcat pdf-path "Single-Lines.pdf")) (mapcar '(lambda (s) (write-line s dsd-fp))(list "[Target]" "Type=6" (strcat "DWF=" pdf-fn) (strcat "OUT=" pdf-path) "PWD=")) (if dsd-fp (progn (close dsd-fp)(gc)))(setq old-filedia (getvar 'filedia))(setvar 'filedia 0)(command "-publish" dsd-fn)(setvar 'filedia old-filedia) ) I've attached last csv file(s) you sent with two more case. I've combined them to one. Note that I've added one line (one but last line in csv because you started with clamp but did not closed it with keyword 'clamp' I have also changed csv engine so it now uses a blank line for next drawing. I still use single symbols for complex branches like 4-way clamp with pop & gp. Have to move on to new project now , so good luck! ATCHAMPETA _ATCHAMPETA _ATCHAMPETA _RING3.pdf CSV-2023-05-18.csv DACHEPALLE_DACHEPALLE_DACHEPALLE_RING2 (2) (1).pdf diagram-1.dwg diagram-1.pdf diagram-2.dwg diagram-2.pdf Single-Lines.pdf SLD.lsp symbols-2023-05-18.zip

Right so this how far I got but something isn't correct what did I do wrong here? Posting this even though it is wrong because I need to know why it is wrong not because I haven't put in the effort to fix it. (defun c:checkdistance (/ Mypoly MyPolyVertexes ) (if (setq MyPoly (ssname (ssget "_+.:E:S" '((0 . "*POLYLINE"))) 0 )) (progn (setq MyPoly (entget (ssname Mypoly 0))) (foreach sublist Mypoly (if (= (car sublist) '10) (setq MyPolyVertexes (append MyPolyVertexes (list (cdr sublist)))))) (princ (entget MyPolyVertexes))) (princ "No polyline found in the drawing.")) (princ) ) Thank you @BIGAL I look forward to implementing that into the code. Many thanks to you as well @Steven P

If all of the PDFs are simple like your example, it may work okay using AutoCAD. But, I would concentrate on fixing the text in the PDF before importing to AutoCAD. Maybe check some Adobe Acrobat fora and/or research the pdftoedit, ImageMagick, Ghostscript, etc. Overall, if you have a lot of them to do, you might be happier with the results. On that note, I have seen PDFIMPORT scripts, LISPs, etc. So fix the text in PDF, then batch create the .dwg for them.

One tip might be to make a new viewport, failing that copy to a new drawing and see if that helps... resets everything to default though, viewport scales, colours and so on, or copy a layout that works and go from there. Oh, also close and restart CAD and the drawng - the old turn it off and on again

I never once said anything about it being brilliant. I do not remember the steps, but you can flatten the PDF and use Acrobat's OCR before bringing into AutoCAD. I used to use Acrobat and Illustrator to create vector from PDF, etc. and previous to that GhostScript, pdftotxt and ImageMagick on PDFs. It's a learning curve, but up until a few years ago I did all of this on a Linux distro and used the terminal a lot. pdftotext(1) (xpdfreader.com ImageMagick – Download With a few tweaks, I usually get pretty good results, there are some settings, as well as you can add more fonts to match up. It is a pain in the *** it only does horizontal text. Though, if you could get a LISP to rotate the view to align them horizontal, it would speed things up. I never tried the OCR in Raster Design, but you could try making the lines in AutoCAD into an image and try different OCR programs, most do reasonably well on black letters on white background. Fortunately for me, I usually have to make them actual text only occasionally these days. Lots more people using TTF fonts as well helps. So here is the settings for set up the PDFSHXTEXT.

@CANDOWE ;just for one (SETQ ENT (CAR (ENTSEL "pick ent"))) (REDRAW ENT 3) ; for a few (SETQ SS-ENT (SSGET))

Thanks. That works great! I also checked out the link and its very informative. I will have to practice more using conditionals rather than IFs.

Yes, defining SS1 as local variable, it will be destroyed once the function exits.

It downloads fine on my end. Must be getting blocked on your computer.

Ok a couple more hints, draw a rectang 297x210 in a layout, offset that rectang 11.25mm, type MV pick bottom left, top right of the inner rectang. Double click inside the rectang and go inside, type ZOOM E, you should see your model now in the mview. You can zoom pan etc and resize what you see ! Now the great part open the toolbar Viewport, for metric users this will be your friend. When you go into a viewport the little box shows a value representing a scale, you can type a value in that box and the viewport will rescale. Its looks like mm plan. So for say 1:100 scale put 0.01 in the box 1:10 put 0.1, I normally work in metres so scale numbers are like 10 5 4 1000/scale, mm 1/scale. The other method is dbl click outside the rectang and you should now be in Paperspace. Click on the viewport and a little blue arrow should appear, click on it and you can choose a scale also. Now Plotting this is Bricscad but the same, output to pdf or a printer choose, Iso A4 sheet size Window A4 sheet size Scale 1=1 Colour.ctb or Acad.ctb Landscape Center on page Then click on Apply button this saves the current settings. Do a preview and check all is ok.

Looks like you accidentally rotated your UCS. This can happen if you're holding down the Shift key while trying to Pan. Type PLAN at the command prompt and then hit the "W" key to reset your view back to normal.

Ok will add L U D R and may be dimming 2 of same pt for some reason will check.

http://web.archive.org/web/20160530183259/https://lispbox.wordpress.com/2015/04/29/centerline-between-two-polyline/

This may be a useful starting point. You need block name and attribute tagname. ; simple update 1 attribute across all layouts ; By Alan H Nov 2020 (defun c:1rev ( / len lay plotabs newstr tabname oldtagn ss1 att x y) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (setq tabs (vla-get-Layouts (vla-get-activedocument (vlax-get-acad-object)))) (setq y 0) (setq ent (nentsel "\nPick an attribute ")) (setq ent2 (ssname (ssget (cadr ent)) 0)) (setq bname (cdr (assoc 2 (entget ent2)))) (setq oldtagn (cdr (assoc 2 (entget (car ent))))) (SETQ NEWSTR (getstring "\nEnter new string ")) (repeat (vla-get-count tabs) (vlax-for lay tabs (setq x (vla-get-taborder lay)) (setq tabname (vla-get-name lay)) (if (and (= y x) (/= tabname "Model")) (progn (setvar "ctab" tabname) (if (setq ss1 (ssget "x" (list (cons 0 "INSERT") (cons 2 bname)(cons 410 tabname)))) (foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes) (if (= oldtagn (strcase (vla-get-tagstring att))) (vla-put-textstring att newstr) ) ) ) ) ) ) (setq y (+ y 1)) ) ) (c:1rev)

Did you google ? Why noy look on Microstation forums this is a lisp forum.

Using lisp you can change variables, for a selected object, so the (command "DIMLUNIT" .... has no effect on what you have selected. Often with dims though need to reset more than 1 variable. Use dumpit.lsp to look at properties you can change them. For a ssget you need to loop through the selection set and use (ssname ssdim x) x is the selection set item number starts at 0. I would also add a filter to your ssget (setq ssdim (ssget '((0 . "DIMENSION") ))) ;;;===================================================================; ;;; DumpIt ; ;;;-------------------------------------------------------------------; ;;; Dump all methods and properties for selected objects ; ;;;===================================================================; (defun C:Dumpit ( / ent) (while (setq ent (entsel)) (vlax-Dump-Object (vlax-Ename->Vla-Object (car ent)) ) ) (princ) ) ;(dumpallproperties (car (entsel))) example of a change a dim (vla-put-arrowheadsize dimobj 5) Do you know how to loop through a selection set ?

I was having the same issue that the original poster asked about and I believe it is related to the Dynamics UCS setting/system variable. Hovering over the icon in question, I get a pop-up display with two lines the first line listing "Snap UCS to active solids plane - On" and the second line listing "Dynamics UCS - UCSDETECT (F6)". After changing the setting to "Off" I no longer see the line "The object is an external reference" appear in the command line. If you use the function keys on your keyboard to turn settings on and off like I do, you may have just accidentally hit F6 and turned this setting on. Hope this solves your problem.

Assuming you mean columns instead of rows, try the following: (defun c:dimtxtexp ( / des dim enx idx sel txt ) (if (and (setq sel (ssget '((0 . "TEXT,MTEXT,*DIMENSION")))) (setq des (open "f:\\BrianD\\Dims.csv" "a")) ) (progn (repeat (setq idx (sslength sel)) (setq enx (entget (ssname sel (setq idx (1- idx))))) (if (wcmatch (cdr (assoc 0 enx)) "*DIMENSION") (setq dim (cons (rtos (cdr (assoc 42 enx))) dim)) (setq txt (cons (cdr (assoc 1 enx)) txt)) ) ) (while (or dim txt) (write-line (strcat (cond ((car txt)) ("")) "," (cond ((car dim)) ("")) "," (cond ((cadr dim)) ("")) ) des ) (setq txt (cdr txt) dim (cddr dim) ) ) ) ) (if (= 'file (type des)) (close des)) (princ) )

Or Lee "Copy Rename Block" http://www.lee-mac.com/copyblock.html

Alan thx for the code... using SSD, the linetype is drawn as continuous. I changed "CES.lin" to nil first but linetype didn't get drawn as HIDDEN2, only continuous. (layer popdown indicates that HIDDEN2 was intended). FYI, PSD function is fine. TIA, Steve

What do you need to change to get your lisp to work with metric units (i.e. width 0.5m instead of 24 inches etc) and not imperial alanjt? I tried changing the lines (setq D2 (/ D 12)) to just (setq D2 (D) althoguh this obviously didn't work.

I don´t know much about lisp... the demonstration is below... I made this quick approach... Once I made a lisp for quick trimming an intersection using polar points... so I thought I could do soemthing similar today.. but I definitely need to read more about it... anyway.. it is a start for someone else to finish it... type storm1 and pick 2 points... it doesn´t work completely right now.. but surely someone will fix it. ;will draw a single line composed of three lines, width is equal to 1 ;base=1" ;it may contain extra code for any pipe size (defun C:storm1 () (setq om (getvar "osmode")) (setq or (getvar "orthomode")) (setvar "cmdecho" 0) (setq p1 (getpoint "\nPick first point.. ")) (setq p2 (getpoint "\nPick second point.. ")) (setvar "osmode" 0) (setvar "orthomode" 0) (command "ucs" pt1 pt2 "") (setq p3 (polar p1 90 0.5)) (setq p5 (polar p1 270 0.5)) (setq p4 (polar p2 90 0.5)) (setq p6 (polar p2 270 0.5)) (command "line" p3 p4 "") (command "line" p5 p6 "") (command "_.-linetype" "load" "hidden2" (strcat "C:/archivos de programa/AutoCAD 2009/UserDataCache/Support/acad.lin") "" "") (command "_.-linetype" "set" "hidden2" "") (command "pline" p1 "W" "1" "1" p2 "") (command "_.-linetype" "set" "bylayer" "") (command "ucs" "w") (setvar "osmode" om) (setvar "orthomode" or) (setvar "cmdecho" 1) (princ) )