smitaranjan Posted May 12, 2023 Author Posted May 12, 2023 Okay I tried to modify in code(your last untested one) little bit and the code works perfectly for 3 cases, only failed when POP is not at the end. So now problem is that previous code works in the logic it will make SLD by POP-POP, but now we require which can make go beyond that POP. Spur GP cases Quote
smitaranjan Posted May 12, 2023 Author Posted May 12, 2023 And also did modifications with symbols too Quote
smitaranjan Posted May 13, 2023 Author Posted May 13, 2023 On 5/12/2023 at 3:20 AM, rlx said: Figure 1 is built with a few of your symbols. I do have a few problems with them. Insertionpoints : They are all over the place (the red one is way down , green one at end of line , the blue one with a gap between it etc). App works with grid (col & row distance in dialog 50mm) and insertion point in center. Attributes (fig 2) : For example 2GPV-Clamp has 2 attributes with same tag (GP) How would app know which one to change if they both have same tag? It would complicate things considerably , not in the last place having to take in account lef-right / up-down. A few symbols if I recall correctly have tag placed at bottom of symbol but symbol is placed on top of line , attribute woud have to be moved. Lisp routine is not designed to work with separate symbols the way you probably want as in the top figure. It works on a grid (row & collumn distance in main dialog , 50mm). It is nearly impossible (for me at least , maybe ChatGPT knows better) to built diagram with both left-right & up-down dynamically. That's why I use one symbol for each branch and all attributes have a unique tag and insertionpoint in the center (shown as red dots in figure 3) what you want is a 'snake within a snake' , dynamically in all directions , and that's not possible with this app in its present form. App would need to be able to read ahead and analyze stuff like AI and that's beyond my capabillaties at this moment. PLEASE find attachment APSFL.zip, little change in the code, csv and symbols and they work for the 3 cases, now only last 2 cases left where its not ending at POP, spur GP case coming. and one more thing in A3 symbols updated attributes to add note if required, which will take from the csv files below row of TOTAL length, please update that too. Quote
rlx Posted May 13, 2023 Posted May 13, 2023 thinking about starting from scratch because you keep changing things and every time I have to re-write my code and this is very frustrating to put it mildly and it takes a lot of my spare time not just one or two hours each time as you may believe. Will try to finish what I started (after I first take a break from this) but after that I'm really done with this. 1 Quote
smitaranjan Posted May 14, 2023 Author Posted May 14, 2023 13 minutes ago, rlx said: thinking about starting from scratch because you keep changing things and every time I have to re-write my code and this is very frustrating to put it mildly and it takes a lot of my spare time not just one or two hours each time as you may believe. Will try to finish what I started (after I first take a break from this) but after that I'm really done with this. Yeah Quote
rlx Posted May 18, 2023 Posted May 18, 2023 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 1 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.