Jump to content

LISP for changing block references to circles


jmsimpson
 Share

Recommended Posts

I have over a thousand block reference points that I have imported into AutoCAD. I would like to convert these block reference "crosshairs" into circles. I want the diameter of these circles to correspond with the elevation numbers from the data set. If you're wondering why I want this, I am trying to make a map of trees in a plot and the diameter is one of the crucial bits of information I want displayed for every tree. Inputing the data in PENZD style limits the amount of information displayed and, since I only need a 2D map, the elevation represents the diameters.

 

I have a lisp code for converting points to circles but I haven't found a way to convert block reference data to circles. If anyone could write that code or instruct me on how this can be accomplished, I would greatly appreciate it. Thanks!

Link to comment
Share on other sites

YOU CAN TEST WITH MY LISP

(defun c:GGG ()  (defun mid (ent / p1 p2)    (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)    (setq p1 (vlax-safearray->list p1)	  p2 (vlax-safearray->list p2)	  pt (mapcar '+ p1 p2)	  pt (mapcar '* pt '(0.5 0.5 0.5))    )    pt  )  (setq src (car (entsel "\nDoi tuong can di chuyen: ")))  (redraw src 3)  (setq des (car (entsel "\nDoi tuong dich: ")))  (redraw src 4)  (setq oldos (getvar "osmode"))  (setvar "osmode" 0)  (command ".move" src "" (mid src) (mid des))  (setvar "osmode" oldos)  (princ))(vl-load-com)

Link to comment
Share on other sites

Since I'm feeling generous today :)

 

(defun c:test ( / el i pt ss x )

 (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
   (repeat (setq i (sslength ss))
     (setq el (entget (ssname ss (setq i (1- i))))
           pt (cdr (assoc 10 el))
     )
     (if
       (entmakex
         (append
           (list
             (cons 0 "CIRCLE")
             (list 10 (car pt) (cadr pt) 0.)
             (cons 40 (if (equal 0.0 (last pt) 1e- 1.0 (abs (/ (last pt) 2.))))
           )
           (apply 'append
             (mapcar
              '(lambda ( x ) (if (assoc x el) (list (assoc x el))))
              '(8 6 39 48 62 210)
             )
           )
         )
       )
       (entdel (cdr (assoc -1 el)))
     )
   )
 )
 (princ)
)

 

EDIT: Just noticed you want a 2D representation, code updated.

Link to comment
Share on other sites

So perhaps it's the operator but I was not able to get either code to work. I copied them into vlisp and saved them as lisps then ran them by apploading them. The shapes of the crosshairs did not change. Am I inputing the code incorrectly? Thanks for taking your time to write the codes, v & leemac

Link to comment
Share on other sites

The first time, it sent all of the points and other files I have in the workspace into a template. That was all that happened. I've tried it a few times afterwards and nothing happened.

Link to comment
Share on other sites

Files? Template? What are you talking about? It should be a case of selecting your blocks and converting them to circles - its a very simple code, there really isn't too much that can go wrong.

Link to comment
Share on other sites

I selected the blocks, input the code into the command and it didn't work. From there, I tried making it work in other ways. I've probably done something wrong but I have barely used this software.

Link to comment
Share on other sites

When you say "it didn't work", what happened? What was printed at the command line? I'm slightly perplexed since I quickly tested the code prior to posting and all worked fine. Is it working for anyone else?

Link to comment
Share on other sites

After loading are you issuing the command 'Test' to run the program?

 

If you are new to LISP, read the 'How to use code in this Archive' thread in the application archive forum. Or there is a tutorial on my site (link in my sig). I would link you to the threads but I'm posting from my mobile.

Link to comment
Share on other sites

Lee Mac,

 

I got it to work. Thanks for your help. My last comment should be evidence as to how much I know about code and AutoCAD.

 

Much Gracious

JMS

Link to comment
Share on other sites

Not a problem JMS, I'm glad it works for you now.

 

After reading back over my other replies, I apologise if I sounded frustrated - I wasn't aware of your inexperience with LISP.

 

Regards,

 

Lee

Link to comment
Share on other sites

Since I'm feeling generous today :)

 

(defun c:test ( / el i pt ss x )

 (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
   (repeat (setq i (sslength ss))
     (setq el (entget (ssname ss (setq i (1- i))))
           pt (cdr (assoc 10 el))
     )
     (if
       (entmakex
         (append
           (list
             (cons 0 "CIRCLE")
             (list 10 (car pt) (cadr pt) 0.)
             (cons 40 (if (equal 0.0 (last pt) 1e- 1.0 (abs (/ (last pt) 2.))))
           )
           (apply 'append
             (mapcar
              '(lambda ( x ) (if (assoc x el) (list (assoc x el))))
              '(8 6 39 48 62 210)
             )
           )
         )
       )
       (entdel (cdr (assoc -1 el)))
     )
   )
 )
 (princ)
)

 

EDIT: Just noticed you want a 2D representation, code updated.

___________________________________________________________________

 

This code works well but I would like to display the point, elevation and description information. I am scouring AutoCad now looking for a way to display the info but if anyone has advice on how to do that, it would be much appreciated

 

JMS

Link to comment
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.   Restore formatting

  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.

 Share

×
×
  • Create New...