Jump to content
syedmeesamali

Offset for each circle center (x,y) from origin and make table

Recommended Posts

syedmeesamali

Hello Everyone, Happy to be part of this CAD forum. I need your help with the following problem.

I have a drawing having circles at various locations (almost 120 circles) each representing a coring location. I need to make a table in the same drawing showing the number of that circle as well as its x,y coordinates with reference from a specific origin to be chosen (not the CAD drawing origin). 

Any help is appreciated as i am new to Visual LISP (Done programming in other languages but not in a LIST processing language). 

Thanks.

target.thumb.png.17617bf9558eefdebfc3bc5b6628acef.png

 

Share this post


Link to post
Share on other sites
Emmanuel Delay

How can we know the core# ?  Is that a text next to the circle?

Share this post


Link to post
Share on other sites
syedmeesamali

Actually core number should also be added by LISP. Even if there is existing core number I don't mind it as I need offsets for circular portion only. 

Share this post


Link to post
Share on other sites
syedmeesamali

I found one code which helps me to find out the x and y from a reference of 0,0 origin. My next problem is to find out size of each circle (by some modification or data extraction from code below) as well as sequentially number the cores (or circles). 

 

(defun c:CircleExport ()
  (setq sset (ssget '((-4 . "<OR")
                                  (0 . "CIRCLE")
                      (-4 . "OR>"))))
  (if sset
    (progn
      (setq itm 0 num (sslength sset))
      (setq fn (getfiled "Point Export File" "" "txt" 1))
      (if (/= fn nil)
        (progn
          (setq fh (open fn "w"))
          (while (< itm num)
            (setq hnd (ssname sset itm))
            (setq ent (entget hnd))
            (setq obj (cdr (assoc 0 ent)))
            (cond 
              ((= obj "CIRCLE")
                (setq pnt (cdr (assoc 10 ent)))
                (princ (strcat 
                               (rtos (car  pnt) 2 8) ";"
                               (rtos (cadr pnt) 2 8) ";"
                               (rtos (caddr pnt) 2 8)) fh)
                (princ "\n" fh)
              ) 
              (t nil)
            )
            (setq itm (1+ itm))
          )
          (close fh)
        )
      )
    )
  )
  (princ)
)
(princ "\nCircleExport loaded, type CircleExport to run. ")
(princ)

 

Share this post


Link to post
Share on other sites
dlanorh
Posted (edited)

Are the core circles on a specific layer? If not how can you identify what is a core and what is just a circle?

Edited by dlanorh

Share this post


Link to post
Share on other sites
Emmanuel Delay
Posted (edited)

This should work

(not sure about your prefered settings, like the size of the texts and table, I assume you want text height of 2.5)

 

COMMAND OCC (for Offset Circle Center)



;;;;;;;;;;;;;;;;;;;
;; draw text object
(defun Text (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str)))
)


;;;;;;;;;;;;;;;;;;;
(vl-load-com)

(defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space)
  ;; settings, text height, cel height
  (setq ht 2.5)
  (setq htc 4.0)
 
  ;; document, model space, ...
  (setq acObj (vlax-get-acad-object)
        acDoc (vla-get-activedocument acObj)
        space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  )

  (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht)  ))  ;;
  (vla-SetTextHeight tab 1 ht)
  (vla-SetTextHeight tab 2 ht)
  (vla-SetTextHeight tab 4 ht)
 
  (setq i 0)
  (repeat (length lst)  ;; iterates the rows
    (vla-setrowHeight tab i htc)
    (setq row (nth i lst))
    (setq j 0)
    (repeat (length row)  ;; iterates the cols in the row
      (princ "\n")
      (princ  (nth j row))
      (vla-SetText tab i j (nth j row) )
      (setq j (+ j 1))
    )
    (setq i (+ i 1))
  )
  ;; default Autocad expects a totle row.  If the first row has more than 1 cel, let's unmerge this row
  (if (> (length (nth 0 lst)) 1)
    (vla-unMergeCells tab 0 0 0 0)
  )
  tab
)

;; Offset for each Circle Center
(defun c:occ ( / lst ss bp pt i ip radi)
  ;; select circles
  (princ "\nSelect circles then press enter: ")
  (setq ss (ssget (list (cons 0 "CIRCLE"))))
  (setq bp (getpoint "\nBase point for offset: "))
  (setq pt (getpoint "\nInsert point of the table: "))
 
  ;; make the list
  (setq lst (list
    (list "Core#" "x" "y")  ;; head
  ))
  (setq i 0)
  (repeat (sslength ss)
    (setq ip (cdr (assoc 10 (entget (ssname ss i)))))    ;; circle center
    (setq radi (cdr (assoc 40 (entget (ssname ss i)))))  ;; circle radius (so we know where to put the label)
    ;; append the list
    (setq lst (append lst (list
      (list  
        (+ i 1)  ;; 1-based counter, Core#
        (rtos (car ip) 2 2)  ;; 2 decimals, feel free to change this
        (rtos (cadr ip) 2 2)
      )
    )))
    (Text
      (list (+ (nth 0 ip) radi) (- (nth 1 ip) radi) )
      2.5
      (strcat "Core " (itoa (+ i 1)))
    )
    (setq i (+ i 1))
  )
  (inserttable lst pt)
)

 

Edited by Emmanuel Delay

Share this post


Link to post
Share on other sites
syedmeesamali

This is just excellent Mr. Emmanuel. Many thanks for your valuable time and effort. There is now one final thing I would like your help with. The text size for the cores is too small as shown below. For Table I just scaled it to suit my needs.

image.png.34ae43d792890a59414df1acb758468c.png

 

Again many thanks for your efforts. 

Share this post


Link to post
Share on other sites
Emmanuel Delay

What text height do you want?  I'll scale it up

Share this post


Link to post
Share on other sites
syedmeesamali

It should be 200. And much better if the color of numbering is something else like maybe red or blue. 

Share this post


Link to post
Share on other sites
Emmanuel Delay



;;;;;;;;;;;;;;;;;;;
;; draw text object
(defun Text (pt hgt str color)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 62 color)
                 (cons 1  str)))
)


;;;;;;;;;;;;;;;;;;;
(vl-load-com)

(defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space)
  ;; settings, text height, cel height
  (setq ht 200)
  (setq htc 380)
 
  ;; document, model space, ...
  (setq acObj (vlax-get-acad-object)
        acDoc (vla-get-activedocument acObj)
        space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  )

  (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht)  ))  ;;
  (vla-SetTextHeight tab 1 ht)
  (vla-SetTextHeight tab 2 ht)
  (vla-SetTextHeight tab 4 ht)
 
  (setq i 0)
  (repeat (length lst)  ;; iterates the rows
    (vla-setrowHeight tab i htc)
    (setq row (nth i lst))
    (setq j 0)
    (repeat (length row)  ;; iterates the cols in the row
      (princ "\n")
      (princ  (nth j row))
      (vla-SetText tab i j (nth j row) )
      (setq j (+ j 1))
    )
    (setq i (+ i 1))
  )
  ;; default Autocad expects a totle row.  If the first row has more than 1 cel, let's unmerge this row
  (if (> (length (nth 0 lst)) 1)
    (vla-unMergeCells tab 0 0 0 0)
  )
  tab
)

;; Offset for each Circle Center
(defun c:occ ( / lst ss bp pt i ip radi)
  ;; select circles
  (princ "\nSelect circles then press enter: ")
  (setq ss (ssget (list (cons 0 "CIRCLE"))))
  (setq bp (getpoint "\nBase point for offset: "))
  (setq pt (getpoint "\nInsert point of the table: "))
 
  ;; make the list
  (setq lst (list
    (list "Core#" "x" "y")  ;; head
  ))
  (setq i 0)
  (repeat (sslength ss)
    (setq ip (cdr (assoc 10 (entget (ssname ss i)))))    ;; circle center
    (setq radi (cdr (assoc 40 (entget (ssname ss i)))))  ;; circle radius (so we know where to put the label)
    ;; append the list
    (setq lst (append lst (list
      (list  
        (+ i 1)  ;; 1-based counter, Core#
        (rtos (car ip) 2 2)  ;; 2 decimals, feel free to change this
        (rtos (cadr ip) 2 2)
      )
    )))
    (Text
      (list (+ (nth 0 ip) radi) (- (nth 1 ip) radi) )
      200
      (strcat "Core " (itoa (+ i 1)))
      160  ;; blue
    )
    (setq i (+ i 1))
  )
  (inserttable lst pt)
)


  • Like 1

Share this post


Link to post
Share on other sites
syedmeesamali

Excellent. Many thanks Mr. Emmanuel. 

  • Like 1

Share this post


Link to post
Share on other sites
syedmeesamali

Just one last request. I also need to add one column to table showing the SIZE of each core. I have only two size i.e. 75mm and 150mm cores. So it will be really helpful if 2nd column is for size in mm and then x and y as usual. 

Share this post


Link to post
Share on other sites
dlanorh
1 hour ago, syedmeesamali said:

Just one last request. I also need to add one column to table showing the SIZE of each core. I have only two size i.e. 75mm and 150mm cores. So it will be really helpful if 2nd column is for size in mm and then x and y as usual. 

 

It would help to know if the core sizes are diameters or radii

Share this post


Link to post
Share on other sites
Emmanuel Delay

I added the Radius .

 

If you want the diameter, then change

(rtos radi 2 2)

to

(rtos (* radi 2.0) 2 2)

If you want the volume:

(rtos (* pi (* radi radi)) 2 2)

 

And thange the title (list "Core#" "x" "y" "Radius")  ;; head

 



;;;;;;;;;;;;;;;;;;;
;; draw text object
(defun Text (pt hgt str color)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 62 color)
                 (cons 1  str)))
)


;;;;;;;;;;;;;;;;;;;
(vl-load-com)

(defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space)
  ;; settings, text height, cel height
  (setq ht 200)
  (setq htc 380)
 
  ;; document, model space, ...
  (setq acObj (vlax-get-acad-object)
        acDoc (vla-get-activedocument acObj)
        space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  )

  (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht)  ))  ;;
  (vla-SetTextHeight tab 1 ht)
  (vla-SetTextHeight tab 2 ht)
  (vla-SetTextHeight tab 4 ht)
 
  (setq i 0)
  (repeat (length lst)  ;; iterates the rows
    (vla-setrowHeight tab i htc)
    (setq row (nth i lst))
    (setq j 0)
    (repeat (length row)  ;; iterates the cols in the row
      (princ "\n")
      (princ  (nth j row))
      (vla-SetText tab i j (nth j row) )
      (setq j (+ j 1))
    )
    (setq i (+ i 1))
  )
  ;; default Autocad expects a totle row.  If the first row has more than 1 cel, let's unmerge this row
  (if (> (length (nth 0 lst)) 1)
    (vla-unMergeCells tab 0 0 0 0)
  )
  tab
)

;; Offset for each Circle Center
(defun c:occ ( / lst ss bp pt i ip radi)
  ;; select circles
  (princ "\nSelect circles then press enter: ")
  (setq ss (ssget (list (cons 0 "CIRCLE"))))
  (setq bp (getpoint "\nBase point for offset: "))
  (setq pt (getpoint "\nInsert point of the table: "))
 
  ;; make the list
  (setq lst (list
    (list "Core#" "x" "y" "Radius")  ;; head
  ))
  (setq i 0)
  (repeat (sslength ss)
    (setq ip (cdr (assoc 10 (entget (ssname ss i)))))    ;; circle center
    (setq radi (cdr (assoc 40 (entget (ssname ss i)))))  ;; circle radius (so we know where to put the label)
    ;; append the list
    (setq lst (append lst (list
      (list  
        (+ i 1)  ;; 1-based counter, Core#
        (rtos (car ip) 2 2)  ;; 2 decimals, feel free to change this
        (rtos (cadr ip) 2 2)
        (rtos radi 2 2)
      )
    )))
    (Text
      (list (+ (nth 0 ip) radi) (- (nth 1 ip) radi) )
      200
      (strcat "Core " (itoa (+ i 1)))
      160  ;; blue
    )
    (setq i (+ i 1))
  )
  (inserttable lst pt)
)

 

Share this post


Link to post
Share on other sites
syedmeesamali

Many Thanks. Just sharing my final image so that it can a good reference for somebody looking for similar problem. In the meanwhile I am trying to get better grasp of VLisp as I have background in Java, C++, Python and VBA (very different from list programming). 

 

image.thumb.png.4c6759f3d3500a489d1e60e6ec0dc6df.png

Share this post


Link to post
Share on other sites
syedmeesamali

@Emmanuel Delay I need one more help. Due to big size of drawing I will take two points as origin for the (x,y) calculation. e.g. one point will be same original origin i.e. 0,0 but the new point will be somewhere around (0, 25000) position. What change do i need to make to take my offsets for upper portion from this new origin? All the details will remain same but i need to split the code in to two separate origin reference points. 

Share this post


Link to post
Share on other sites
BIGAL

You set UCS origin to a new point this may do what you want no code change

Share this post


Link to post
Share on other sites
syedmeesamali

@BIGAL OK I tried the below but whenever the program finishes still the circle offsets are taken from original origin i.e. 0,0 (WCS) and not the new WCS which is 0,33000 from the original.

 

(setq pt1 "0,33000,0") 
(command ".UCS" "Origin" pt1)

What should i change?

Share this post


Link to post
Share on other sites
Emmanuel Delay
Posted (edited)

Answering a further request, asked in another topic

>> Is there any way to make it bit more regular (like starting from bottom left and continuing in some logical fashion) or there is no way around?

 

I sorted the ss selection by X value (of the insert point of the circles).  That makes it a lot more searchable.

I also ask the user for a start number.  So if, for example, you have a North wing of a building with 130 cores, you can start the South wing with number 131.

 

(I removed the text "Core", set the text height to 300 and color to 200 of the labels).

 

Notice, I could reuse function insert_sorted  to sort the ss selection, here by the x-value instead of by an ID

 

;;;;;;;;;;;;;;;;;;;
;; draw text object
(defun Text (pt hgt str color)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 62 color)
                 (cons 1  str)))
)


;;;;;;;;;;;;;;;;;;;
(vl-load-com)

(defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space)
  ;; settings, text height, cel height
  (setq ht 200)
  (setq htc 380)
 
  ;; document, model space, ...
  (setq acObj (vlax-get-acad-object)
        acDoc (vla-get-activedocument acObj)
        space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  )

  (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht)  ))  ;;
  (vla-SetTextHeight tab 1 ht)
  (vla-SetTextHeight tab 2 ht)
  (vla-SetTextHeight tab 4 ht)
  
  (vla-put-VertCellMargin tab (* 0.14 ht))
  
  (setq i 0)
  (repeat (length lst)  ;; iterates the rows
    (vla-setrowHeight tab i htc)
    (setq row (nth i lst))
    (setq j 0)
    (repeat (length row)  ;; iterates the cols in the row
      ;;(princ "\n")
      ;;(princ  (nth j row))
      (vla-SetText tab i j (nth j row) )
      (setq j (+ j 1))
    )
    (setq i (+ i 1))
  )
  ;; default Autocad expects a totle row.  If the first row has more than 1 cel, let's unmerge this row
  (if (> (length (nth 0 lst)) 1)
    (vla-unMergeCells tab 0 0 0 0)
  )
  tab
)

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

;; there is a list of lists.  (list (list ID IND)) .  If holds a numeric ID (1 2 3 ...);
;; IND holds the index of the unsorted list
;; This function inseerts a new item, its position in the list depending on its ID.
(defun insert_sorted (lst_sorted id ind / lst_new inserted id_ i)
  (setq inserted nil)
  (setq lst_new (list))
  (if (= (length lst_sorted) 0)
    (progn
      ;; first item, so we insert it
      (setq lst_new (list (list
        id ind
      )))
    )
    (progn
      (setq i 0)
      ;; we loop through the existing list.  When the new ID is smaller than the ID in the list  => we insert the new item there
      (foreach item lst_sorted
        (setq id_ (nth 0 item))
        (if (and (= inserted nil) (< id id_)) (progn
          (setq lst_new (append lst_new (list (list
            id ind
          ))))
          (setq inserted T)
        ))
        ;; continue copying the items from lst_sorted to lst_new
        (setq lst_new (append lst_new (list (list
          (nth 0 item) (nth 1 item)
        ))))
        (setq i (+ i 1))
      )
      ;; if the item isn't inserted yet we add it to the end
      (if (= inserted nil)
        (setq lst_new (append lst_new (list (list
          id ind
        ))))
      )
    )
  )
  lst_new  
)

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

(defun sort_ss_by_xy (ss xOry / i j data item ip)
 
  (setq i 0)
  (setq data (list))
  (repeat (sslength ss)
    (setq ip (cdr (assoc 10 (entget (ssname ss i)))))  ;; insert point of the core
    (if (= xOry "x")
      ;; sort by x
      (setq data (insert_sorted data (nth 0 ip) i))
      ;; sort by y
      (setq data (insert_sorted data (nth 1 ip) i))
    )
    (setq i (+ i 1))
  )
  ;;(princ data)
 
  ;; now let's rebuild a ss selection, but sorted like data
  (setq ss_sorted (ssadd))
  (foreach item data
    (setq j (nth 1 item))  ;; j now holds the index of the ss selection
    (ssadd (ssname ss j) ss_sorted)
  )
  ss_sorted
)

;; Offset for each Circle Center
(defun c:occ ( / lst startnumber ss ss_sorted bp pt i ip radi)
  ;; select circles
  (princ "\nSelect circles then press enter: ")
  (setq ss (ssget (list (cons 8 "Cores") (cons 0 "CIRCLE"))))
 
  (setq ss (sort_ss_by_xy ss "x"))
 
  (setq bp (getpoint "\nBase point for offset: "))
  (setq pt (getpoint "\nInsert point of the table: "))
 
  (setq startnumber (getint "\nStart Number: "))
 
  ;; make the list
  (setq lst (list
    (list "Core#" "x" "y" "Radius")  ;; head
  ))
  (setq i 0)
  (repeat (sslength ss)
    (setq ip (cdr (assoc 10 (entget (ssname ss i)))))    ;; circle center
    (setq radi (cdr (assoc 40 (entget (ssname ss i)))))  ;; circle radius (so we know where to put the label)
    ;; append the list
    (setq lst (append lst (list
      (list  
        (+ i startnumber )  ;; counter, starting with user set start number
        (rtos (car ip) 2 2)  ;; 2 decimals, feel free to change this
        (rtos (cadr ip) 2 2)
        (rtos radi 2 2)
      )
    )))
    (Text
      (list (+ (nth 0 ip) (* 2. radi)) (- (nth 1 ip) radi) )
      300
      (itoa (+ i startnumber))
      200  ;; purple
    )
    (setq i (+ i 1))
  )
  (inserttable lst pt)
)

Edited by Emmanuel Delay
  • Thanks 1

Share this post


Link to post
Share on other sites
syedmeesamali

Wow you're the hero Mr. Emmanuel. Super thanks for all your efforts and help. Now I got full set of tools to deal with messy corings and got complete control over them. 

 

BTW I also bought the book "AutoCAD Developers Guide to Visual LISP" in order make myself more familiarized with AutoLISP and also to develop my own programs. 

 

Thanks a lot. 🌻

  • Like 1

Share this post


Link to post
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...