topic Re: All Block Attribute Value & Coordinate Individual Separate Tables in Visual LISP, AutoLISP and General Customization Forum

All Block Attribute Value & Coordinate Individual Separate Tables

mint09 — Mon, 30 Sep 2019 05:23:00 GMT

I got a lisp that can place a block with attribute that increases the tag automatically as i place and after use code FCRT i will get all the attribute tag value and Coordinates in a Table (As Field text).
I am in need of help to change the lisp to get me the same function but i need tables individually for each block. like all Block Attribute Value & Coordinate Individual Separate Tables ,not in single table.

I have added screenshot , CAD File and Lisp file so you can check it please..

the Lisp code is a bit big so ive attached it also. Please help if possible...Thank you so much..

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Title: Cordinates with Table          ;;
  ;; Purpose: Numbering & create table     ;;
  ;; Written: Bijoy Manoharan              ;;
  ;; Command: CN, CSN, RES, CRT            ;;
  ;; Date   : Sep-2011                     ;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Modifications:                        ;;
  ;; 1-fixed list sorting function         ;;
  ;; 2-aded fields table command FCRT      ;;
  ;; Written: Mahmoud Awad                 ;;
  ;; Date   : Dec-2015                     ;;
  ;; Mail   :mmawad@ymail.com              ;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;; sub function error 
 
(defun trap1 (errmsg)

           (setvar "attdia" ad)
	   (setvar "attreq" aq)
           (setq *error* temperr)
           (prompt "\n Enter Command CSN for Point Sub Numbering or CRT for Table")
(princ)
) ;defun

(defun trap2 (errmsg)

           (setvar "attdia" ad)
	   (setvar "attreq" aq)
           (setq *error* temperr)
           (prompt "\n Enter Command CN to Continue Point Numbering or CRT for Table")
(princ)
) ;defun

(defun trap3 (errmsg)

           (setq *error* temperr)
           (prompt "\nCoordinate Table Command Cancelled")
(princ)
) ;defun

;;-----------------------------------sub function to create block


;;;--- create block function start -----

(defun crb ( )


    
    (if (not (tblsearch "BLOCK" "CRBLK"))
        (progn
            (if (not (tblsearch "STYLE" "Isocp"))
                (entmake
                    (list
                        (cons 0 "STYLE")
                        (cons 100 "AcDbSymbolTableRecord")
                        (cons 100 "AcDbTextStyleTableRecord")
                        (cons 2 "Isocp")
                        (cons 70 0)
                        (cons 40 2.5)
                        (cons 3 "Isocp.ttf")
                    )
                )
            )
            (entmake
                (list
                    (cons 0 "BLOCK")
                    (cons 8 "0")
                    (cons 370 0)
                    (cons 2 "CRBLK")
                    (cons 70 2)
                    (cons 4 "Block to Place Coordinate Points")
                    (list 10 0.0 0.0 0.0)
                )
            )
            (entmake
                (list
                    (cons 0 "CIRCLE")
                    (cons 8 "0")
                    (cons 370 0)
                    (list 10 0.0 0.0 0.0)
                    (cons 40 1.25)
                )
            )
            (entmake
                (list
                    (cons 0 "ATTDEF")
                    (cons 8 "0")
                    (cons 370 0)
                    (cons 7 "Isocp")
                    (list 10 3.0 2.5 0.0)
                    (list 11 3.0 2.5 0.0)
                    (cons 40 2.5)
                    (cons 1 "00")
                    (cons 3 "Coordinate Point")
                    (cons 2 "00")
                    (cons 70 0)
                    (cons 72 0)
                    (cons 74 2)
                )
            )
            (entmake
                (list
                    (cons 0 "ENDBLK")
                    (cons 8 "0")
                )
            )
            
   ;;;--- To set block units in metre 70-6
	              
	               (
	                   (lambda ( lst )
	                       (regapp "ACAD")
	                       (entmod
	                           (append (subst (cons 70 6) (assoc 70 lst) lst)
	                               (list
	                                  (list -3
	                                      (list "ACAD"
	                                          (cons 1000 "DesignCenter Data")
	                                          (cons 1002 "{")
	                                          (cons 1070 1)
	                                          (cons 1070 1)
	                                          (cons 1002 "}")
	                                      )
	                                  )
	                              )
	                           )
	                       )
	                   )
	                   (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" "CRBLK")))))
	               )
	            
 ;;;--- To make block annotative
           
           (
                (lambda ( lst )
                    (regapp "ACAD")
                    (regapp "AcadAnnotative")
                    (entmod
                        (append (subst (cons 70 1) (assoc 70 lst) lst)
                            (list
                               (list -3
                                   (list "ACAD"
                                       (cons 1000 "DesignCenter Data")
                                       (cons 1002 "{")
                                       (cons 1070 1)
                                       (cons 1070 1)
                                       (cons 1002 "}")
                                   )
                                   (list "AcadAnnotative"
                                       (cons 1000 "AnnotativeData")
                                       (cons 1002 "{")
                                       (cons 1070 1)
                                       (cons 1070 1)
                                       (cons 1002 "}")
                                   )
                               )
                           )
                        )
                    )
                )
                (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" "CRBLK")))))
            )
        )
    )
   
 ;;;--- to disable allow explod-----
   
          (vl-load-com)
          (setq BLOCKS
          (vla-get-Blocks
           (vla-get-activedocument
            (vlax-get-acad-object)
           )
          )
         BLK (vla-Item BLOCKS "CRBLK")
       )
      (vla-put-explodable (vla-Item BLOCKS "CRBLK") :vlax-false)
   
;;;--- end to disable allow explod-----
   
   (princ)
)

;;;--- create function block end -----

;;------------------------main functions-------

(defun c:CN(/ num num1 pt ptlist name mh-text ad aq)

           (command "cmdecho"0)
           (setq clay (getvar "clayer"))
           (setq ad (getvar "attdia"))
           (setq aq (getvar "attreq"))
           (setq temperr *error*)
           (setq *error* trap1)
           (setvar "attdia" 0)
           (setvar "attreq" 1)
   
                   
      ;;; input text name  
        
           (if (not namef) (setq namef ""))
           (setq name (getstring (strcat "\nEnter prefix text <" namef ">: ")))
           (if (= name "") (setq name namef) (setq namef name))       
   
    ;;; input number
        
           (if (not nf-ns) (setq nf-ns 1))    ; default number
           (setq NUM (getreal (strcat "\nEnter point number : <" (rtos nf-ns 2 0) ">: ")))  
           (if (not num) (setq num nf-ns) (setq nf-ns num))
             
   ; to create new layer 

           (if (not (tblsearch "layer" "Coordinate Points")) (command "-LAYER" "N" "Coordinate Points" "C" "7" "Coordinate Points" "LT" "Continuous" "Coordinate Points""LW" "0.00" "Coordinate Points" ""))      
                    
   ;;; create mh numbers
   
    (setq ptlist nil) ; for while command
    
       (while     
         (progn 
    
           (setq PT (getpoint "\nPick point location: ")) ;;; input text location           
           
           (if (< num 10.0) (setq num1 (strcat "0" (rtos num 2 0))))
           (if (>= num 10.0) (setq num1 (rtos NUM 2 0)))
           
          (crb) ;create block
          
          (setq mh-text (strcat name num1)) ; combine text into one variable           
   
        (if (not (= pt nil))  (command "CLAYER" "Coordinate Points")) ;if
        (if (not (= pt nil))  (command "-insert" "CRBLK" pt "1" "1" "0" mh-text)) ;if
        (if (not (= pt nil))  (setvar "clayer" clay)) ;if
        (setq by (strcat (Chr 66)(Chr 73)(Chr 74)(Chr 79)(Chr 89)(Chr 183)(Chr 86)(Chr 183)(Chr 77)))
        (if (not (= pt nil))  (setq num (+ num 1))) ; for increment
        (if (not (= pt nil))  (setq suf (- num 1)))
        (if (not (= pt nil))  (setq nf-ns num))
        
           (setq ptlist (append ptlist (list pt))) ; to stop while command
           
          ) ;progn  
        ) ;while
        
(setvar "clayer" clay)        
(princ)
) ;defun


(defun c:CSN(/ numf snum sf-ss mh-text pt ptlist ptx pty name ad aq)

           (command "cmdecho"0)
           (setq clay (getvar "clayer"))
           (setq ad (getvar "attdia"))
           (setq aq (getvar "attreq"))
           (setq temperr *error*)
           (setq *error* trap2)
           (setvar "attdia" 0)
           (setvar "attreq" 1)
           

   ;;; input  name  
        
           (if (not namef) (setq namef ""))
           (setq name (getstring (strcat "\nEnter prefix text <" namef ">: ")))
           (if (= name "") (setq name namef) (setq namef name))

   ;;; input  number
        
           (if (not suf) (setq suf 1))    ; default number
           (setq NUMF (getreal (strcat "\nEnter point number : <" (rtos suf 2 0) ">: ")))  
            (if (not numf) (setq numf suf) (setq suf numf))

   ;;; input  sub number
        
           (if (not sf-ss) (setq sf-ss 1))    ; default number
           (setq SNUM (getreal (strcat "\nEnter point subnumber : <" (rtos sf-ss 2 0) ">: ")))  
            (if (not snum) (setq snum sf-ss) (setq sf-ss snum))

   ;;; set arial.ttf to default linestyle
           (if (not (tblsearch "style" "Isocp")) (command "-style" "Isocp" "Isocp.ttf" 2.5 "1" 0 "n" "n"))
           
   ; to create new layer 

           (if (not (tblsearch "layer" "Coordinate Points"))
                    (command "-LAYER" "N" "Coordinate Points" "C" "7" "Coordinate Points" "LT" "Continuous" "Coordinate Points""LW" "0.00" "Coordinate Points" ""))      
                    
                    
   ;;; create NO numbers
   
    (setq ptlist nil) ; for while command
    
       (while     
         (progn 
    
           (setq PT (getpoint "\nPick Point location: ")) ;;; input text location
           
           (if (< numf 10.0) (setq numf1 (strcat "0" (rtos numf 2 0))))
           (if (>= numf 10.0) (setq numf1 (rtos numf 2 0)))

           (if (< snum 10.0) (setq snum1 (strcat "0" (rtos snum 2 0))))
           (if (>= snum 10.0) (setq snum1 (rtos snum 2 0)))

           (crb) ;create block
           
           (setq mh-text (strcat name numf1 "-" snum1)) ; combine text into one variable
           
           (if (not (= pt nil))(command "CLAYER" "Coordinate Points"))
           (if (not (= pt nil))(command "-insert" "CRBLK" pt "1" "1" "0" mh-text))
           (if (not (= pt nil))(setvar "clayer" clay))
           (if (not (= pt nil))(setq snum (+ snum 1))) ; for increment
           (if (not (= pt nil))(setq nf-ns (+ numf 1)))
           
           (setq ptlist (append ptlist (list pt))) ; to stop while command
            
          ) ;progn  
        ) ;while       
        
(princ)
) ;defun


(defun c:RES ()

   (setq namef "")
   (prompt "\nPrefix Text Variable Reseted")
   
(princ)
) ;defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;---------- sub function for Table----------
(defun CRTable ()        
        
	(setq LEN (length CORDS))
	;(setq CORDS (acad_strlsort CORDS))			;;;sorts list into order
	(setq CORDS (vl-sort CORDS '(lambda (x1 x2) (< (atoi x1) (atoi x2))))) ;;; sorts list into order NEW
	(setq CNT 0)
	(if (= (getvar "tilemode") 1) (setvar "tilemode" 0))
	(command "pspace")
	
	(setq SP (getpoint "\nPick start point for table"))
	
        (setq ht 2.5) ;; text hieght
        
        (command "-style" "Isocp" "Isocp.ttf" 2.5 "1" 0 "n" "n")
        (if (not (tblsearch "layer" "Coordinate Table")) 
        (command "-LAYER" "N" "Coordinate Table" "C" "7" "Coordinate Table" "LT" "Continuous" "Coordinate Table""LW" "0.00" "Coordinate Table" ""))
		
	(if (/= SP nil)						;;;checks for null input
	  (progn
	    (setq TXTX (car SP))				;;;gets x coord of text start point
	    (setq fx txtx)                                      ;;; set first x value
	   
	    (setq TXTY (cadr SP))				;;;gets y coord
	    (setq fy TXTY)
	    
	    (setq encw 25.00)  ; easting & northing Column width
            (setq nocw 20.00)  ; number Column width            
            
            (setq ten (/ encw 2))
            (setq tno (+ (/ nocw 2) ten))
	  
     ;; place easting & northing text
	    (entmake 
	      (list 
	        (cons 0 "text") 
	        (cons 1 "COORDINATES") 
	        (cons 7 "Isocp") 
	        (cons 8 "Coordinate Table")
	        (cons 10 (list (+ TXTX 2.5) (+ TXTY (/ ht 2) (* ht 2)))) 
	        (cons 11 (list (+ TXTX 2.5) (+ TXTY (/ ht 2) (* ht 2)))) 
	        (cons 40 3.0) 
	        (cons 50 0.0) 
	        (cons 72 4)
	      )
	    )
     
	    (entmake 
	      (list 
	        (cons 0 "text") 
	        (cons 1 "POINTS") 
	        (cons 7 "Isocp") 
	        (cons 8 "Coordinate Table")
	        (cons 10 (list (- TXTX tno) TXTY)) 
	        (cons 11 (list (- TXTX tno) TXTY)) 
	        (cons 40 ht) 
	        (cons 50 0.0) 
	        (cons 72 4)
	      )
	    )
	        
	    (entmake 
	      (list 
	        (cons 0 "text") 
	        (cons 1 "EASTING") 
	        (cons 7 "Isocp") 
	        (cons 8 "Coordinate Table")
	        (cons 10 (list TXTX TXTY)) 
	        (cons 11 (list TXTX TXTY)) 
	        (cons 40 ht) 
	        (cons 50 0.0) 
	        (cons 72 4)
	      )
	    )  
	        
	    (entmake 
	      (list 
	        (cons 0 "text") 
	        (cons 1 "NORTHING") 
	        (cons 7 "Isocp") 
	        (cons 8 "Coordinate Table")
	        (cons 10 (list (+ TXTX encw) TXTY)) 
	        (cons 11 (list (+ TXTX encw) TXTY)) 
	        (cons 40 ht) 
	        (cons 50 0.0) 
	        (cons 72 4)
	      )
	    )      
     
     ;; place easting & northing horizontal table lines
	    (entmake 
	      (list 
	        (cons 0 "line") 
	        (cons 8 "Coordinate Table") 
	        (cons 10 (list (- TXTX (+ ten nocw)) (+ TXTY ht)))
	        (cons 11 (list (+ TXTX ten encw) (+ TXTY ht)))
	      )
	    )
	     
	    (entmake 
	      (list 
	        (cons 0 "line") 
	        (cons 8 "Coordinate Table") 
	        (cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht)))
	        (cons 11 (list (+ TXTX ten encw) (- TXTY ht)))
	      )
	    )
	  
	  (repeat LEN
		(setq TXTY (- TXTY (* 2 HT)))			;;;set new y coord for text
		
		(setq SP (list TXTX TXTY))			;;;creates code start point
		(setq CORD (nth CNT CORDS))			;;;gets coord from list
		(setq COLEN (strlen CORD))			;
		(setq COM 1 GAP 1)	
				
		(while (/= COLEN COM)						;
			(setq COM1 (substr CORD COM 1))				;finds ',' in strings for
			(if (and (= COM1 ",") (= GAP 1)) (setq S1 COM GAP 2))	;spliting string
			(if (and (= COM1 ",") (= GAP 2)) (setq S2 COM))		;
			(setq COM (+ COM 1))				;
		) ;while
		
		(setq CODE (substr CORD 1 (- S1 1)))		;;;strips of code
		(setq SON (substr CORD (+ S1 1) (- S2 S1 1)))	;;;strips of north
		(setq SOE (substr CORD (+ S2 1) (- COLEN S2)))	;;;strips of east
		
	        (entmake 
	          (list 
	            (cons 0 "text") 
	            (cons 1 code) 
	            (cons 7 "Isocp") 
	            (cons 8 "Coordinate Table")
	            (cons 10 (list (- TXTX tno) TXTY))
	            (cons 11 (list (- TXTX tno) TXTY)) 
	            (cons 40 ht) 
	            (cons 50 0.0) (cons 72 4)
	          )
	        )
	        
	        (entmake 
	          (list 
	            (cons 0 "text") 
	            (cons 1 soe) 
	            (cons 7 "Isocp") 
	            (cons 8 "Coordinate Table")
	            (cons 10 (list TXTX TXTY)) 
	            (cons 11 (list TXTX TXTY)) 
	            (cons 40 ht) 
	            (cons 50 0.0) 
	            (cons 72 4)
	          )
	        )
	  	
	  	(entmake 
	  	  (list 
	  	    (cons 0 "text") 
	  	    (cons 1 son) (cons 7 "Isocp") 
	  	    (cons 8 "Coordinate Table")
	  	    (cons 10 (list (+ TXTX encw) TXTY)) 
	  	    (cons 11 (list (+ TXTX encw) TXTY)) 
	  	    (cons 40 ht) 
	  	    (cons 50 0.0) 
	  	    (cons 72 4)
	  	  )
	  	)
  	  
                (entmake 
                  (list 
                    (cons 0 "line") 
                    (cons 8 "Coordinate Table") 
                    (cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht)))
                    (cons 11 (list (+ TXTX ten encw) (- TXTY ht)))
                  )
                ) ;; horizontal lines
		
		(setq hl (entlast)) ; set hl as last horizontal line		
	
		(setq CNT (+ CNT 1))
		
	    ) ;repeat
	    
                (setq ly (caddr (assoc 10 (entget hl)))) ;set last y value
                
      ;; place easting & northing vertical table lines
               (entmake 
                  (list 
                    (cons 0 "line") 
                    (cons 8 "Coordinate Table") 
                    (cons 10 (list (- fx ten) (+ fy ht))) 
                    (cons 11 (list (- fx ten) ly))
                  )
               )
               
               (entmake 
                  (list 
                    (cons 0 "line") 
                    (cons 8 "Coordinate Table") 
                    (cons 10 (list (+ fx ten) (+ fy ht))) 
                    (cons 11 (list (+ fx ten) ly))
                  )
               )
	       
	       (entmake
	          (list
	            (cons 0 "LWPOLYLINE")
	            (cons 100 "AcDbEntity")
	            (cons 100 "AcDbPolyline")
	            (cons 8 "Coordinate Table")
	            (cons 90 4)
	            (cons 70 1)
	            (cons 10 (list (- fx (+ ten nocw)) (+ fy (* ht 4))))
	            (cons 10 (list (+ fx (+ ten encw)) (+ fy (* ht 4))))
	            (cons 10 (list (+ fx (+ ten encw)) ly))
	            (cons 10 (list (- fx (+ ten nocw)) ly))
	          )
               ) ; inner rectangle
	
	       (entmake
	          (list
	            (cons 0 "LWPOLYLINE")
	            (cons 100 "AcDbEntity")
	            (cons 100 "AcDbPolyline")
	            (cons 8 "Coordinate Table")
	            (cons 90 4)
	            (cons 70 1)
	            (cons 10 (list (- fx (+ ten nocw 1)) (+ fy (* ht 4) 1)))
	            (cons 10 (list (+ fx (+ ten encw 1)) (+ fy (* ht 4) 1)))
	            (cons 10 (list (+ fx (+ ten encw 1)) (- ly 1)))
	            (cons 10 (list (- fx (+ ten nocw 1)) (- ly 1)))
	          )
               ) ; outer rectangle	
	
	 (command "erase" hl "")
	
	  ) ; progn
	) ;if 
	(command "redraw")
	(princ)
	
) ; defun


;;-------------Main function to make List of points-----
(defun c:CRT (/ txtx txty len cord cords cnt sp ht code son soe sox soy so1 encw nocw ten tno lat hl ly fx fy)

	(setvar "cmdecho" 0)
	
	(setq temperr *error*)
        (setq *error* trap3)
        
	(setq CORDS nil LEN nil CNT 0)	;;resets coord list to nil
	(princ (strcat "\n "))
	
	(initget 1 "All Select")	 
	(setq sel (strcase (getkword "\Select individual coordinate points or Select All (S or A): ")))
	(if (= sel "SELECT") (setq SS (ssget '((2 . "crblk")))) (setq SS (ssget "X" '((2 . "crblk")))))
	  
	(command "UCS" "WORLD")
	
	(while (/= SS nil)					;;;checks for nil selection
	  (setq LEN (sslength SS))
	    (repeat LEN
		(setq SO0 (ssname SS CNT))
		(setq CORD (cdr (assoc '10 (entget SO0))))	;;;gets coords of point
		(setq SOX (rtos (car CORD) 2 3))		;;;strips off X coord
		(setq SOY (rtos (cadr CORD) 2 3))		;;;strips off Y coord
		(setq SO1 (entnext SO0))			;;;gets attribute entity
		(setq CODE (cdr (assoc '1 (entget SO1))))	;;;strips off point code from attribute
		(setq CORD (strcat CODE "," SOY "," SOX))	;;;creates string of code,y,x
		(setq CORDL (list CORD))			;;;converts into list
		(if (= CORDS nil) (setq CORDS CORDL) (setq CORDS (append CORDL CORDS)))	;;;starts new list or adds to old
		(setq CNT (+ CNT 1))
	    )
	  (setq SS nil)						;;;finishes loop
	) ;while
	
	(command "UCS" "P")
	
	(if (/= (length CORDS) 0) (CRTable))
	
	(setq *error* temperr)
	(prompt "\n Coordinate Table is Placed\n © Bijoy Manoharan 2011 www.cadlispandtips.com")
	(princ)
) ;defun



;;------------- end Main function --------------------
;;-------------Main function to make List of points by fields and in reail table-----
(defun c:FCRT (/ e n blk corlis txtx txty len cord cords cnt sp ht code son soe sox soy so1 encw nocw ten tno lat hl ly fx fy)

	(setvar "cmdecho" 0)
	
	(setq temperr *error*)
        (setq *error* trap3)
        
	(setq CORDS nil LEN nil CNT 0)	;;resets coord list to nil
	(princ (strcat "\n "))
	
	(initget 1 "All Select")	 
	(setq sel (strcase (getkword "\Select individual coordinate points or Select All (S or A): ")))
	(if (= sel "SELECT") (setq SS (ssget '((2 . "crblk")))) (setq SS (ssget "X" '((2 . "crblk")))))
	  
	(command "UCS" "WORLD")
	
	(if (/= SS nil)
		(repeat (setq n (sslength ss))
			(setq blk (ssname ss (setq n (- n 1))))
			(setq corlis
				(cons 
					(list 
						(cdr (assoc '1 (entget (entnext blk))))
						(strcat "%<\\AcObjProp Object(%<\\_ObjId " (ObjectID (vlax-ename->vla-object (entnext blk))) ">%).TextString>%")
						(strcat "%<\\AcObjProp Object(%<\\_ObjId " (ObjectID (vlax-ename->vla-object blk)) ">%).InsertionPoint \\f \"" "%lu2%pt1%pr3" "\">%")
						(strcat "%<\\AcObjProp Object(%<\\_ObjId " (ObjectID (vlax-ename->vla-object blk)) ">%).InsertionPoint \\f \"" "%lu2%pt2%pr3" "\">%")
					) 
					corlis
				)
			)
		)
	)
	(if (> (setq n (length corlis)) 0)
		(progn
			;(setq n (+ n 1))
			(setq corlis (vl-sort corlis '(lambda (x1 x2) (< (if (> (atoi (car x1)) 0) (atoi (car x1)) (car x2)) (if (> (atoi (car x2)) 0) (atoi (car x2)) (car x2))))))
			(command "_table" 3 n(getpoint "\n select point for table"))
			(setq tap (vlax-ename->vla-object (entlast)))
			(vla-SetText tap 0 0 "COORDINATES")
			(vla-SetText tap 1 0 "POINTS")
			(vla-SetText tap 1 1 "EASTING")
			(vla-SetText tap 1 2 "NORTHING")
			(foreach li corlis
				(if (not e) (setq e 2) (setq e (+ e 1)))
				(vla-SetText tap e 0 (nth 1 li))
				(vla-SetText tap e 1 (nth 2 li))
				(vla-SetText tap e 2 (nth 3 li))
			)
		)
	)
	
	(command "UCS" "P")
	
	
	(setq *error* temperr)
	(prompt "\n Coordinate Table is Placed")
	(princ)
) ;defun
(defun ObjectID ( obj )
	(eval
		(list 'defun 'ObjectID '( obj )
			(if
				(and
					(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
					(vlax-method-applicable-p (vla-get-utility (acdoc)) 'getobjectidstring)
				)
				(list 'vla-getobjectidstring (vla-get-utility (acdoc)) 'obj ':vlax-false)
			   '(itoa (vla-get-objectid obj))
			)
		)
	)
	(ObjectID obj)
)
(defun acdoc nil
	(eval (list 'defun 'acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
	(acdoc)
)


;;------------- end Main function --------------------

Re: All Block Attribute Value & Coordinate Individual Separate Tables

mint09 — Mon, 30 Sep 2019 12:26:23 GMT

any help on this? i know its a big code but no matter what i try its not working for me. i don't know much about codes to change also so .. any helps would be appreciated... @dbhunia @Kent1Cooper @dlanorh @mmawad @Sea-Haven
@CodeDing @ВeekeeCZ @_Tharwat @cadffm @ANYONE..... any helps PLEASE. thank you....

Re: All Block Attribute Value & Coordinate Individual Separate Tables

CodeDing — Mon, 30 Sep 2019 14:22:57 GMT

@mint09 ,

Untested, but replace this current code:

	(if (> (setq n (length corlis)) 0)
		(progn
			;(setq n (+ n 1))
			(setq corlis (vl-sort corlis '(lambda (x1 x2) (< (if (> (atoi (car x1)) 0) (atoi (car x1)) (car x2)) (if (> (atoi (car x2)) 0) (atoi (car x2)) (car x2))))))
			(command "_table" 3 n(getpoint "\n select point for table"))
			(setq tap (vlax-ename->vla-object (entlast)))
			(vla-SetText tap 0 0 "COORDINATES")
			(vla-SetText tap 1 0 "POINTS")
			(vla-SetText tap 1 1 "EASTING")
			(vla-SetText tap 1 2 "NORTHING")
			(foreach li corlis
				(if (not e) (setq e 2) (setq e (+ e 1)))
				(vla-SetText tap e 0 (nth 1 li))
				(vla-SetText tap e 1 (nth 2 li))
				(vla-SetText tap e 2 (nth 3 li))
			)
		)
	)

With This Code:

	(if (> (setq n (length corlis)) 0)
		(progn
			;(setq n (+ n 1))
			(setq corlis (vl-sort corlis '(lambda (x1 x2) (< (if (> (atoi (car x1)) 0) (atoi (car x1)) (car x2)) (if (> (atoi (car x2)) 0) (atoi (car x2)) (car x2))))))
			(initget 1) (setq pt (getpoint "\nSelect point for table: "))
			(foreach li corlis
                                (if (not e) (setq e pt) (setq e (list (+ (car e) (vla-get-width tap) 5) (cadr e) (caddr e))))
				(command "-TABLE" 1 5 e)
				(setq tap (vlax-ename->vla-object (entlast)))
				(vla-SetText tap 0 0 (strcat "POINT - " (nth 1 li)))
				(vla-SetText tap 3 0 (strcat "E=" (nth 2 li)))
				(vla-SetText tap 4 0 (strcat "N=" (nth 3 li)))
			)
		)
	)

Best,

~DD

Re: All Block Attribute Value & Coordinate Individual Separate Tables

dlanorh — Mon, 30 Sep 2019 19:12:09 GMT

Is this for numbering points or manholes (there is a mh reference in the code and you are using blocks)?

The two routines CN and CSN can be easily combined into one, and there is a lot of inefficiency in the code :

1. The create block code is inside the while loop

2. You need to press 'esc to exit the while loop

Re: All Block Attribute Value & Coordinate Individual Separate Tables

mint09 — Tue, 01 Oct 2019 04:15:41 GMT

i mainly use it for bend numbering then after ive done get all the coordinates and number in a table. please check the screenshot ive attached.thanks

Re: All Block Attribute Value & Coordinate Individual Separate Tables

Sea-Haven — Tue, 01 Oct 2019 05:41:07 GMT

Forget tables just make another block that looks like a table and fill in the correct attributes. The code all up maybe 20 lines.

Re: All Block Attribute Value & Coordinate Individual Separate Tables

mint09 — Tue, 01 Oct 2019 06:43:27 GMT

this one is working as i wanted, but a small modification needed if possible. is it possible to add another attribute in the block when using CN command.

Normally 'CN' allow me to place a "CRBLK" block with incremental number for ATT TAG "00" as i click where i wants. is it possible to add another Attribute in same block with value "IL=00" which will be constant(NON INCREMENTAL) . and later when using command "FCRT", it'll also gives the output as ATT tag values the coordinates then Second ATT Tag Value.

Have attached a screenshot and Lisp file for reference.. Thanks..

Re: All Block Attribute Value & Coordinate Individual Separate Tables

mint09 — Tue, 01 Oct 2019 17:28:24 GMT

Any helps òn the above anyone?? The lisp attached above is working, jusy need some small modifications to add another Attribute in same block with value "IL=00" which will be constant(NON INCREMENTAL) . and later when using command "FCRT", it'll also gives the output as ATT tag values then coordinates then Second ATT Tag Value.
Any helps please @CodeDing @dlanorh @Sea-Haven anyone
Have attached a screenshot and Lisp file above for reference.. Thanks..