dxfval options, textToVal, pt2block download

downloaded/Pt2Block.lsp

@@ -0,0 +1,138 @@
+
+;|
+                            PT2BLOCK.LSP
+                           Michael Weaver
+                          2175 George Road
+                      Fairbanks, Alaska 99712
+                    (907)488-3577 voice and fax
+                  Email:71461.1775@compuserve.com
+                 Mike_Weaver_Alascad@compuserve.com
+                           Fri 02-23-1996
+                          (c)1996 Alascad
+
+
+
+This routine will replace points (nodes) in the current drawing will
+insertions of a specified block.  The insertion scale factor and the
+rotation angle for block are supplied by the operator.
+
+Example:
+
+command: PT2BLOCK
+Name of block to insert: MYBLOCK
+Insertion scale factor: 1
+Insertion rotation angle: 0
+Select points: <Select points to replace>
+
+   Replace MYBLOCK with the name of your block.  An enter at the
+Select points prompt will select all points in the drawing database
+(current space and excluding points found on layer DEFPOINTS).
+
+The blocks will be inserted on the same layer as the points.
+
+|;
+
+(defun c:pt2block(;		replace points with blocks
+  /;				no arguments
+  attreq;			value to restore
+  cmdecho;			value to restore
+  bname;			block name to insert
+  temp;				temp variable
+  ent;				entity name
+  elist;			entity list
+  scf;				insertion scale factor
+  rotang;			insertion rotation angle
+  ss1;				selection set of points
+  indx;				index through selection set
+  sslen;			number of points selected
+  inspt;			insertion point
+ );				end of local variable list
+ (if (and
+   (setq
+    bname (getstring "\nName of block to insert: ")
+    temp (/= "" bname)
+   )
+   (progn
+    (if (or
+      (tblsearch "BLOCK" bname);	the block exists in the drawing
+      (findfile (strcat bname ".dwg"));	the block can be pulled from disk
+     );				end or
+     T;				continue
+     (progn
+      (alert (strcat "Block " bname " not found."))
+      nil
+     );				end progn
+    );				end if block found?
+   );				end progn check for block
+   (setq scf (getreal "\nInsertion scale factor: "))
+   (setq rotang (getangle "\nInsertion rotation angle: "))
+   (setq
+    ss1 (ssget
+     '((0 . "POINT");		get points
+       (-4 . "<NOT");		not on 
+        (8 . "DEFPOINTS");	layer DEFPOINTS
+       (-4 . "NOT>");		end not
+      );			end the quoted filter list
+     );				end ssget
+    temp (if (and ss1 (< 0 (sslength ss1)));	was anything selected
+     T
+     (setq 
+      ss1 (ssget
+       "X"
+       '((0 . "POINT");		get points
+        (-4 . "<NOT");		not on 
+         (8 . "DEFPOINTS");	layer DEFPOINTS
+        (-4 . "NOT>");		end not
+       );			end the quoted filter list
+      );			end ssget
+     );				end setq (nested)
+    );				end if?
+   );				end setq (outer)
+   (if (< 0 (sslength ss1))
+    T
+    (progn
+     (alert "No points found.")
+     nil
+    );				end progn
+   );				end if points found?
+  );				end and
+  (progn
+   (setq
+    attreq (getvar "attreq");	value to restore
+    cmdecho (getvar "cmdecho");	value to restore
+    indx -1;			a counter
+    sslen (sslength ss1);	number of points selected
+   )
+   (setvar "attreq" 0)
+   (setvar "cmdecho" 0)
+   (while (> sslen (setq indx (1+ indx)))
+    (setq
+     ent (ssname ss1 indx);	entity name
+     elist (entget ent);		entity list
+     inspt (cdr (assoc 10 elist));location of the point
+     inspt (trans inspt ent 1)
+    );				end setq
+    (entmake
+     (list
+      '(0 . "INSERT")
+      (cons 2 bname)
+      (assoc 8 elist)
+      (cons 10 inspt)
+      (cons 41 scf)
+      (cons 42 scf)
+      (cons 43 scf)
+      (cons 50 (* rotang (/ pi 180)))
+      (assoc 210 elist)
+     );				end list
+    );				end entmake
+    (entdel ent);		get rid of the point
+    (princ ".");			indicate progress
+   );				end while
+   (setvar "attreq" attreq)
+   (princ (strcat "\t" (itoa sslen) " points replaced. "))
+   (command "_.redraw")
+   (setvar "cmdecho" cmdecho)
+  );				end progn
+ );				end if valid input?
+ (princ)
+);				end c:pt2block

dxfval.lsp

@@ -6,7 +6,7 @@
 ;; gyetpet@gmail.com
 ;; gyetvai-peter.hu
 
-(defun C:dxfval (/ i imax il j jmax jl x ss currElem code groupCode sube en2 enlist2 )
+(defun C:dxfval (/ i imax il j jmax jl x ss currElem code groupCode sube listauto savefile f savepath en2 enlist2 )
     ;variables:
     (setq i 0);counter to zero
     (setq imax 1);while variable
@@ -29,25 +29,60 @@
     (setq il (sslength ss));length of selection
     (prompt "\nDxf group code: (leave empty for all) ")
     (setq groupCode (getint))
-    (print groupCode)
+    
 
     (initget 1 "Yes No")
     (setq sube (getkword "List sub entities? [Yes/No]"))
     
+    ; ------------------------------ output settings ----------------------------- ;
+    (if (< 1 il)
+        (progn
+            (initget 1 "Yes No")
+            (setq listauto (getkword "List all automatically? [Yes/No]"))
+        )
+        (setq listauto "No")
+    )
+
+    (initget 1 "Yes No")
+    (setq savefile (getkword "Save to file? [Yes/No]"))
+    (if (= savefile "Yes")
+        (progn
+            (setq savepath (getfiled "Output path" "" "" 1))
+            (setq f (open savepath "w"))
+        )
+    )
+
+
+    ; -------------------------- going through elements -------------------------- ;
     (while imax
+        
+        ; -------------------- long output only for non auto list -------------------- ;
+        (if (= listauto "No")
+            (progn
                 (print )
                 (print )
                 (princ "Checking element ")
                 (princ (1+ i))
                 (princ "/")
                 (princ il)
-
+                (print )
+            )
+            (progn
+                (print )
+                (princ (strcat (itoa (1+ i)) ":"))
+            )
+        )
         (setq currElem (entget (ssname ss i) ))
 
+
         (if groupCode 
+            ; --------------------- print only groupcode if added --------------------- ;
             (progn
-                (print (cdr (assoc groupCode currElem)))
+                (princ (cdr (assoc groupCode currElem)))
+                (if (= savefile "Yes") (prin1 (cdr (assoc groupCode currElem)) f))
+                
             )
+            ; --------------------- print all if groupcode not added --------------------- ;
             (progn
                 (setq jl (length currElem))
 
@@ -65,6 +100,7 @@
 
                 
                 (setq en2(entnext (ssname ss i))) ;- Get the next sub-entity
+                ; ------------------------------- sub entities ------------------------------- ;
 
                 (if (and en2 (= sube "Yes"))
                     (progn
@@ -92,13 +128,13 @@
                             )
                         )
                     )
-                )
+                );- sub entities end
             )
         )
 
         
 
-        (if (not (or (= il 1)(= (1+ i) il)))
+        (if (and (not (or (= il 1)(= (1+ i) il))) (= listauto "No"))
             (progn
                 (prompt "\nPress any key to continue to the next element: ")
                 (setq code (grread))
@@ -111,6 +147,7 @@
         (if (= i il) (setq imax nil));finish function if i equals il
     )
 
+    (if (= savefile "Yes") (close f))
     (setq ss nil)
     (princ)
 )

textToValue.lsp

@@ -0,0 +1,37 @@
+(defun C:textToValue (/ tt readval bb)
+    ;; (setq i 0);counter to zero
+    ;; (setq imax 1);while variable
+
+    (vl-load-com)
+    (graphscr)
+
+    (setq tt (entsel "\nPick text object"))
+
+    (setq readval (print (cdr (assoc 1 (entget (car tt))))))
+
+    (setq bb (entsel "\nPick block with attribute"))
+
+    (LM:setattributevalue (car bb) "HEIGHT" readval)
+
+)
+
+;; Set Attribute Value  -  Lee Mac
+;; Sets the value of the first attribute with the given tag found within the block, if present.
+;; blk - [ent] Block (Insert) Entity Name
+;; tag - [str] Attribute TagString
+;; val - [str] Attribute Value
+;; Returns: [str] Attribute value if successful, else nil.
+
+(defun LM:setattributevalue ( blk tag val / enx )
+    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
+        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
+            (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
+                (progn
+                    (entupd blk)
+                    val
+                )
+            )
+            (LM:setattributevalue blk tag val)
+        )
+    )
+)