Jump to content

Need help .. radiation report lisp

scubastu

By scubastu
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

scubastu Enthusiast

scubastu

Posted
Posted

Hi fellow friends,

 

OK I have tried writing a lisp the reports the radiations from a User selected block to any blocks within a fuzz distance.

 

I was going fine until now where I seemed to have stuff things up.

 

first problem (which I didn't have before)

 

; error: bad argument type: lentityp nil

 

Second

 

Also how can I exclude the first zero length line from the report?

 

Third

 

I'm not sure if my ssget command to get attribute values is valid.. if it isn't how can I get these as these show where each reported line is going.

 

Thanks in advance.

 

;;;Start program
 (defun c:radi (/ nlist hnd hne )
  (setq nlist (ssadd))
   (setq angtype (getvar "AUNITS"))
   (setq oprec (getvar "AUPREC"))
   (setq ounits (getvar "LUNITS"))
   (setq ouprec (getvar "LUPREC"))
 ;;;Setup file to write to
 (setq path (getvar "dwgprefix"))
 (setq nameo (getvar "DWGNAME"))
 (setq namelen (- (strlen nameo) 4))
 (setq nameshrt (substr nameo 1 namelen))
 (setq name (strcat nameshrt " - Radial Report.txt"))
 (setq fname (strcat path name))
 (setq fn (open fname "w"))
 (write-line (strcat "\t\t\t\Radial Report\n\n\n") fn)
 (close fn)
  ;;;Get user info
   (setq ent (entget (car (entsel "\Select Block to Radial Report from"))))
 (setq pt1 (cdr (assoc 10 ent)))
   (setq att1 (cdr (assoc 1 (entget (entnext (cdr (assoc -1 ent)))))))
     (setq fuz (getdist pt1 "\nEnter fuzz distance: Select perimeter point"))
     (setq ss (ssget "_X" (list '(-4 . "<,<,<")(cons 10 (list (+ (car pt1) fuz)
                                                        (+ (cadr pt1) fuz)
                                                        (+ (caddr pt1) fuz)
                           ))
                           '(-4 . ">,>,>")(cons 10 (list (- (car pt1) fuz)
                                                        (- (cadr pt1) fuz)
                                                        (- (caddr pt1) fuz)
                           ))
             )))
 ;;;Process user info
 (setq len (sslength ss) cntr 0)
 (while (< cntr len)
   (progn
 (setq hnd (ssname ss cntr))
       (setq en (entget hnd))
     (setq typ (cdr (assoc 0 en)))
     (if (= typ "INSERT")
(progn
       (setq pt2 (cdr (assoc 10 en)))
     (command "._line" pt1 pt2 "")))
     (setq entl (entlast))
     (ssadd entl nlist)
     (setq cntr (1+ cntr))
))
;;;; write info to file
(setq lenx (sslength nlist) indx 0)
(while (< indx lenx)
   (progn
     (setq hne (ssname nlist indx))
     (setq enl (entget hne))
     (setq p1 (cdr (assoc 10 enl))
    p2 (cdr (assoc 11 enl)))
     (setq ang (angle p1 p2)
    dis (distance p1 p2))
     (setq enb (entget (entnext (ssname (ssget "_x" (list '(-4 . "=,=,*")(cons 10 (cdr (assoc 11 enl)))(cons 0 "INSERT"))) indx))))
     (setq att (cdr (assoc 1 enb)))
     (setq indx (1+ indx))
     (setq fn (open fname "a"))
     (if (= indx 1)
(write-line (strcat "\tFrom\t" att1 "\tTo") fn))
     (if (> indx 1)
     (write-line (strcat (itoa indx) "\t\t" (angtos ang angtype oprec) "\t\t" (rtos dis ounits ouprec) "\t\t" att) fn))
     (close fn))
     )
  )

Lee Mac Grand Master

Lee Mac

Posted
Posted

Stu,

 

There was a lot wrong with your LISP, but from your code, I think I have written something along the lines of what you are after.

 

The code below will use the first attribute in the block as I did not know of the tag you wanted to use:

 

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:radi [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] *error* mk_line

                AP AU BLK BPT DOC DW ENT I J LP
                LU OBJLST OFILE PT RAD SS UFLAG[b][color=RED])[/color][/b]

 [i][color=#990099];; by Lee Mac  ~  17.12.2009[/color][/i]
 
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error* [b][color=RED]([/color][/b]msg[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] ofile [b][color=RED]([/color][/b][b][color=BLUE]close[/color][/b] ofile[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#ff00ff]"*BREAK,*CANCEL*,*EXIT*"[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#ff00ff]"\n** Error: "[/color][/b] msg [b][color=#ff00ff]" **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] mk_line [b][color=RED]([/color][/b]p1 p2[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]entmake[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#ff00ff]"LINE"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]10[/color][/b] p1[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]11[/color][/b] p2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] au [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"AUNITS"[/color][/b][b][color=RED])[/color][/b] ap [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"AUPREC"[/color][/b][b][color=RED])[/color][/b]
       lu [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"LUNITS"[/color][/b][b][color=RED])[/color][/b] lp [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"LUPREC"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] doc [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] j [b][color=#009900]0[/color][/b] i [b][color=#009900]-1[/color][/b] ss  [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_X"[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#ff00ff]"INSERT"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=#009900]66[/color][/b] . [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] blk [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] [b][color=#ff00ff]"\nSelect Block to Radiate from: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

         [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b]  [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=DARKRED]'[/color][/b]ENAME [b][color=RED]([/color][/b][b][color=BLUE]type[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

                  [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#ff00ff]"INSERT"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]0[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                                [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]1[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]66[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                    
                    [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** Object must be an Attributed Block **"[/color][/b][b][color=RED])[/color][/b]
                    [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] blk ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

               [b][color=RED]([/color][/b]  [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** Nothing Selected **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bPt [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     
     [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] rad [b][color=RED]([/color][/b][b][color=BLUE]getdist[/color][/b] bPt [b][color=#ff00ff]"\nSpecify Radius for Report: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-StartUndoMark[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         
         [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] i[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

           [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]distance[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pt [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] bPt[b][color=RED])[/color][/b] rad[b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
               [b][color=RED]([/color][/b]mk_line bPt pt[b][color=RED])[/color][/b]

               [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Objlst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b]

                              [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-TextString[/color][/b]
                                      [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b]
                                        [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke[/color][/b]
                                          [b][color=RED]([/color][/b][b][color=BLUE]Vlax-ename->vla-object[/color][/b] ent[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b]GetAttributes[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] j [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] j[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

                                    [b][color=RED]([/color][/b][b][color=BLUE]angtos[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]angle[/color][/b] bPt pt[b][color=RED])[/color][/b] au ap[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]distance[/color][/b] bPt pt[b][color=RED])[/color][/b] lu lp[b][color=RED])[/color][/b][b][color=RED])[/color][/b] ObjLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] ObjLst
           [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ofile [b][color=RED]([/color][/b][b][color=BLUE]open[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"DWGPREFIX"[/color][/b][b][color=RED])[/color][/b]
                                       [b][color=RED]([/color][/b][b][color=BLUE]substr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] dw [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"DWGNAME"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#009900]1[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strlen[/color][/b] dw[b][color=RED])[/color][/b] [b][color=#009900]4[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

                                       [b][color=#ff00ff]" - Radial Report.txt"[/color][/b][b][color=RED])[/color][/b] [b][color=#ff00ff]"w"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]write-line[/color][/b] [b][color=#ff00ff]"\t\t\tRadial Report\n\n\n"[/color][/b] ofile[b][color=RED])[/color][/b]

             [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] 
                   [b][color=RED]([/color][/b][b][color=BLUE]write-line[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#ff00ff]"\tFrom:\t"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] x[b][color=RED])[/color][/b] [b][color=#ff00ff]"\tTo: "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] x[b][color=RED])[/color][/b]
                                            [b][color=#ff00ff]"\t\t"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caddr[/color][/b] x[b][color=RED])[/color][/b] [b][color=#ff00ff]"\t\t"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadddr[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b] ofile[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]reverse[/color][/b] ObjLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

             [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ofile [b][color=RED]([/color][/b][b][color=BLUE]close[/color][/b] ofile[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

           [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** No Blocks Found Within Radius **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** No Blocks Found in Drawing **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

scubastu Enthusiast

scubastu

Posted
  • Author
Posted
Stu,

 

There was a lot wrong with your LISP, but from your code, I think I have written something along the lines of what you are after.

 

The code below will use the first attribute in the block as I did not know of the tag you wanted to use:

 

 

Hi Lee,

 

Thanks for the help. I knew I was going about it the wrong I am still new at this. First attribute is perfect.

 

The report should be like this

 

Radial Report

From BM3

 

To

 

1 132d12'32" 25.356 BM2

2 216d35'45" 30.284 BM1

3 183d15'35" 50.616 BM4

 

etc...

 

Lines are also temporary and can be deleted.. not even sure if they are needed at all.

 

Congrats on your other lisps too they're awsome!

Lee Mac Grand Master

Lee Mac

Posted
Posted

I see - so you only want the "From : XXX" to appear once, and take the attribute value of the base block that is selected. :)

scubastu Enthusiast

scubastu

Posted
  • Author
Posted
I see - so you only want the "From : XXX" to appear once, and take the attribute value of the base block that is selected. :)

 

 

yep! right on

Lee Mac Grand Master

Lee Mac

Posted
Posted

Try this:

 

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:radi [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] *error* mk_line

                AP AU BLK BPT DOC DW ENT I J LP
                LU OBJLST OFILE PT RAD SS UFLAG

                Lines[b][color=RED])[/color][/b]

 [i][color=#990099];; by Lee Mac  ~  17.12.2009[/color][/i]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Lines [b][color=BLUE]nil[/color][/b][b][color=RED])[/color][/b] [i][color=#990099];; <<-- Draw Lines to Blocks[/color][/i]
 
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error* [b][color=RED]([/color][/b]msg[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] ofile [b][color=RED]([/color][/b][b][color=BLUE]close[/color][/b] ofile[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#ff00ff]"*BREAK,*CANCEL*,*EXIT*"[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#ff00ff]"\n** Error: "[/color][/b] msg [b][color=#ff00ff]" **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] mk_line [b][color=RED]([/color][/b]p1 p2[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]entmake[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#ff00ff]"LINE"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]10[/color][/b] p1[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]11[/color][/b] p2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] au [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"AUNITS"[/color][/b][b][color=RED])[/color][/b] ap [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"AUPREC"[/color][/b][b][color=RED])[/color][/b]
       lu [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"LUNITS"[/color][/b][b][color=RED])[/color][/b] lp [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"LUPREC"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] doc [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] j [b][color=#009900]0[/color][/b] i [b][color=#009900]-1[/color][/b] ss  [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_X"[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#ff00ff]"INSERT"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=#009900]66[/color][/b] . [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] blk [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] [b][color=#ff00ff]"\nSelect Block to Radiate from: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

         [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b]  [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=DARKRED]'[/color][/b]ENAME [b][color=RED]([/color][/b][b][color=BLUE]type[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

                  [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#ff00ff]"INSERT"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]0[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                                [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]1[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]66[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                    
                    [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** Object must be an Attributed Block **"[/color][/b][b][color=RED])[/color][/b]
                    [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] blk ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

               [b][color=RED]([/color][/b]  [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** Nothing Selected **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bPt [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     
     [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] rad [b][color=RED]([/color][/b][b][color=BLUE]getdist[/color][/b] bPt [b][color=#ff00ff]"\nSpecify Radius for Report: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-StartUndoMark[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         
         [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] i[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

           [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]distance[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pt [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] bPt[b][color=RED])[/color][/b] rad[b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] Lines [b][color=RED]([/color][/b]mk_line bPt pt[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

               [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Objlst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] j [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] j[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                                        
                                        [b][color=RED]([/color][/b][b][color=BLUE]angtos[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]angle[/color][/b] bPt pt[b][color=RED])[/color][/b] au ap[b][color=RED])[/color][/b]
                                        
                                        [b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]distance[/color][/b] bPt pt[b][color=RED])[/color][/b] lu lp[b][color=RED])[/color][/b][b][color=RED])[/color][/b] ObjLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] ObjLst
           [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ofile [b][color=RED]([/color][/b][b][color=BLUE]open[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"DWGPREFIX"[/color][/b][b][color=RED])[/color][/b]
                                       [b][color=RED]([/color][/b][b][color=BLUE]substr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] dw [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"DWGNAME"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#009900]1[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strlen[/color][/b] dw[b][color=RED])[/color][/b] [b][color=#009900]4[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

                                       [b][color=#ff00ff]" - Radial Report.txt"[/color][/b][b][color=RED])[/color][/b] [b][color=#ff00ff]"w"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]write-line[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#ff00ff]"\t\t\tRadial Report\n\nFrom: "[/color][/b]
                       [b][color=RED]([/color][/b][b][color=BLUE]vla-get-TextString[/color][/b]
                         [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b]
                           [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke[/color][/b]
                             [b][color=RED]([/color][/b][b][color=BLUE]Vlax-ename->vla-object[/color][/b] blk[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b]GetAttributes[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#ff00ff]"\n\nTo: \n"[/color][/b][b][color=RED])[/color][/b] ofile[b][color=RED])[/color][/b]

             [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] 
                   [b][color=RED]([/color][/b][b][color=BLUE]write-line[/color][/b]
                     [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] x[b][color=RED])[/color][/b] [b][color=#ff00ff]"\t\t"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] x[b][color=RED])[/color][/b] [b][color=#ff00ff]"\t\t"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caddr[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b] ofile[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

               [b][color=RED]([/color][/b][b][color=BLUE]reverse[/color][/b] ObjLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

             [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ofile [b][color=RED]([/color][/b][b][color=BLUE]close[/color][/b] ofile[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

           [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** No Blocks Found Within Radius **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** No Blocks Found in Drawing **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

scubastu Enthusiast

scubastu

Posted
  • Author
Posted
Try this:QUOTE]

 

Perfect Lee.. We are indebted to your knowledge.. its members like you that make places like this all that it is!:D

 

I'm gonna study this so I know what its doing and why :?

Lee Mac Grand Master

Lee Mac

Posted
Posted

Oh, 1 thing I forgot to mention, this will only report attributed blocks - I wasn't sure if that was your original intention?

scubastu Enthusiast

scubastu

Posted
  • Author
Posted
Oh, 1 thing I forgot to mention, this will only report attributed blocks - I wasn't sure if that was your original intention?

 

 

Yep that's fine.. but I just noticed something.. the attributes aren't being written to the file.. I added (cadddr x) into the write-line statement copying your first one as it was missing and now I'm getting stringp nil and no info written to file.. I'll leave it to you while I pack to head to the States!

 

Thanks again

Lee Mac Grand Master

Lee Mac

Posted
Posted

Ahh, sorry dude, missed that!

 

(defun c:radi (/ *error* mk_line

                AP AU BLK BPT DOC DW ENT I J LP
                LU OBJLST OFILE PT RAD SS UFLAG

                Lines)

 ;; by Lee Mac  ~  17.12.2009

 (setq Lines nil) ;; <<-- Draw Lines to Blocks
 
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (and ofile (close ofile))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun mk_line (p1 p2)
   (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))

 (setq au (getvar "AUNITS") ap (getvar "AUPREC")
       lu (getvar "LUNITS") lp (getvar "LUPREC"))

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (if (setq j 0 i -1 ss  (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (progn

     (while
       (progn
         (setq blk (car (entsel "\nSelect Block to Radiate from: ")))

         (cond (  (eq 'ENAME (type blk))

                  (if (not (and (eq "INSERT" (cdr (assoc 0 (entget blk))))
                                (eq 1 (cdr (assoc 66 (entget blk))))))
                    
                    (princ "\n** Object must be an Attributed Block **")
                    (not (ssdel blk ss))))

               (  (princ "\n** Nothing Selected **")))))

     (setq bPt (cdr (assoc 10 (entget blk))))
     
     (if (setq rad (getdist bPt "\nSpecify Radius for Report: "))
       (progn
         (setq uFlag (not (vla-StartUndoMark doc)))
         
         (while (setq ent (ssname ss (setq i (1+ i))))

           (if (< (distance (setq pt (cdr (assoc 10 (entget ent)))) bPt) rad)
             (progn
               (and Lines (mk_line bPt pt))

               (setq Objlst (cons (list (itoa (setq j (1+ j)))
                                        
                                        (angtos (angle bPt pt) au ap)
                                        
                                        (rtos (distance bPt pt) lu lp)

                                        (vla-get-TextString
                                          (car
                                            (vlax-invoke
                                              (Vlax-ename->vla-object ent) 'GetAttributes)))) ObjLst)))))
         (if ObjLst
           (progn
             (setq ofile (open (strcat (getvar "DWGPREFIX")
                                       (substr (setq dw (getvar "DWGNAME")) 1 (- (strlen dw) 4))

                                       " - Radial Report.txt") "w"))
             (write-line
               (strcat "\t\t\tRadial Report\n\nFrom: "
                       (vla-get-TextString
                         (car
                           (vlax-invoke
                             (Vlax-ename->vla-object blk) 'GetAttributes))) "\n\nTo: \n") ofile)

             (mapcar
               (function
                 (lambda (x) 
                   (write-line
                     (strcat (car x) "\t\t" (cadr x) "\t\t" (caddr x) "\t\t" (cadddr x)) ofile)))

               (reverse ObjLst))

             (setq ofile (close ofile)))

           (princ "\n** No Blocks Found Within Radius **"))

         (setq uFlag (vla-EndUndoMark doc)))))

   (princ "\n** No Blocks Found in Drawing **"))

 (princ))

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
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
Go to topic listing
×
×
  • Create New...