How to fill Dynamic block attribute based on polyline value

[bdx]

Hi everyone,

 

I am new to AutoLISP and am looking to find out what I need to learn to solve this problem. I have a process that is done for hundreds of lots per project and hope to automate more of it.

 

The Goal

I want to automatically fill in the dynamic object attribute values based on the associated polyline length.

 

Current Workflow

1. Get polyline length by clicking line and checking length attribute.

2. Input the lot numbers and associated polyline length into an excel sheet

4. Excel sheet does calculation to get total length and runs if/else statement to get description

5. ATTOUT Dynamic block containing 'Square #', 'totalLength', and 'Description' attributes

6. Copy ATTOUT data to an excel sheet and merge my values to this sheet.

7. Save data as a Tab-Delimited text file

6. ATTIN text file back to drawing. (which populates my data to the dynamic blocks)

 

 

Any suggestions are greatly appreciated! Are there any existing Lisps I can modify for this? 

Edited May 20, 2022 by bdx
typo

[mhupp]

No need for steps 2 - 6 everything can be done in cad. it will be automatic so no need to having to maintain multiple files. and if you change the polyline or lot number it would update.

 

upload a sample drawing with all relative blocks

 

 

 

 

[bdx]

I have attached the sample drawing.

 

There is another few steps I forgot to mention. For the sake of simplicity, I would like to at least get the TotalLength stored in the Dynamic block and I can tackle the Description problem later.

 

--------------------------------------------

More info for the Description Problem

 

The calculations for the Description variable depends on user inputted values that vary per drawing and the transformer (red triangle block where the polyline comes from) that feeds the lot. This means I would need to somehow prompt the user to input those values and store them in a variable or reference some kind of table. This sounds like a more complex problem I may not be experienced enough to solve yet.

 

This is the setup sheet where user inputs values in orange cells for the maximum wire length per wire type and per transformer size.

 

This is what my excel formula looks like that references values in the setup sheet above.

=IF(AND([@[XFMR Size]]=25,[@[SVC Total]]<=Setup!$C$9),wire_types[1/0], 
IF(AND([@[XFMR Size]]=25,[@[SVC Total]]>Setup!$C$9,[@[SVC Total]]<=Setup!$C$10),wire_types[4/0], 
IF(AND([@[XFMR Size]]=25,[@[SVC Total]]>Setup!$C$10), "ERROR", 
IF(AND([@[XFMR Size]]=50,[@[SVC Total]]<=Setup!$C$13),wire_types[1/0], 
IF(AND([@[XFMR Size]]=50,[@[SVC Total]]>Setup!$C$13,[@[SVC Total]]<=Setup!$C$14),wire_types[4/0], 
IF(AND([@[XFMR Size]]=50,[@[SVC Total]]>Setup!$C$14), "ERROR", 
IF(AND([@[XFMR Size]]=75,[@[SVC Total]]<=Setup!$C$17),wire_types[1/0], 
IF(AND([@[XFMR Size]]=75,[@[SVC Total]]>Setup!$C$17,[@[SVC Total]]<=Setup!$C$18),wire_types[4/0],
 IF(AND([@[XFMR Size]]=75,[@[SVC Total]]>Setup!$C$18),"ERROR","undefined"
)))))))))

 

@mhupp

 

 

 

sample.dwg

Edited May 21, 2022 by bdx
to @ user who asked for sample drawing

[Steven P]

For the user inputs you might be able to reduce ths. For example cable and transfomer sizes tend to be discrete, unlikely to get an AWG 3.12 cable or 13.25mm or a 11.56kVA Trasformer. Your work might make this even easier that you mightonly ever specify 3 or 4 sizes of transformer and only low voltage (120 / 220V) cable and one or 2 cable sizes. So from that it might be that you can make up a data table, or simple calculation to calculate the max lengths

 

Your user input might be something like this:

"Select Line or enter [s] for settings"

and in settings they can enter transformer and cable sizes, perhasp saved into the regisetry for future next time it s used.

 

Making up the data table / look up table / cable calulation might take you a little effort but could reduce the work required, taking away some of the set up time.

[bdx]

On 5/21/2022 at 8:18 PM, Steven P said:

Your work might make this even easier that you mightonly ever specify 3 or 4 sizes of transformer and only low voltage (120 / 220V) cable and one or 2 cable sizes. So from that it might be that you can make up a data table, or simple calculation to calculate the max lengths

Yes, my client only uses two service wire sizes and a handful of transformer sizes.

 

Quote

Making up the data table / look up table / cable calulation might take you a little effort but could reduce the work required, taking away some of the set up time.

This is what I am going to do.  Having some kind of table would be convenient, especially if I can export it to excel for other required forms. I'm just having a hard to visualizing what this will look like.  For example, how to do I associate each polyline to a specific lot. I just learned about Object Data and I think this may help. I will spend more time looking into this.

 

The user input suggestion does sound good, but I would need to ask the user to select the associated lot label as well, right?

 

For example, I would need to:

1. Run command

2. Select [sw] for wire setup to input maximum wire sizes per transformer (Only needs updated once per project)

3. Select [st] for transformer setup to choose transformer size (User updates every 6 lots)

4. Select line

5. Select lot label

6. program calculates total length and updates lot label.

[mhupp]

Sorry i had some code worked up but its on my home pc ill post it when I get home.

[mhupp]

I reused a little trick making small selection sets at the ends of the polyline to get the plot number and xfmr size.

https://www.cadtutor.net/forum/topic/75207-count-number-of-polylines-near-other-polylines/

 

So the only thing you will have to select is the polyline and the attribute block you want to update. if the area of pt1 and pt2 is too small (nothing is selected) it will prompt you to manually select them.  This happens in plot 10 & 11 of your example drawing. You will have to update the lengths to set the wire sizes #### in the lisp

 

another "error" that i saw is plot 5 polyline is 40' short. So i added highlighting the polyine at the end to for visual confrontation. so keep an eye out.

 

(defun C:foo (/ poly len spt pt1 pt2 SST lot SSX xfmr ept wire)
  (while (setq poly (vlax-ename->vla-object (setq e (car (entsel "\nSelect Polyline")))))
    (setq len (+ (* 10 (fix ((if (minusp (vla-get-length poly)) - +) (/ (vla-get-length poly) (float 10)) 0.5))) 15)) ;Lee Mac round to nearest 10' add 15'
    (setq spt (vlax-curve-getStartPoint poly))
    (setq pt1 (mapcar '- spt '(30 30)))
    (setq pt2 (mapcar '+ spt '(30 30)))
    ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window
    (cond
      ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1))
        (setq lot (cdr (assoc 1 (entget (ssname ss 0)))))        
      )
      ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SST) 1))
        (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA"))
      )
    )
    (setq SST nil SSX nil)
    (setq ept (vlax-curve-getendpoint poly))
    (setq pt1 (mapcar '- ept '(30 30)))
    (setq pt2 (mapcar '+ ept '(30 30)))
    ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window
    (cond
      ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SSX) 1))
        (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA"))
      )
      ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1))
        (setq lot (cdr (assoc 1 (entget (ssname ss 0)))))        
      )
    )
    (if xfmr
      (progn)
      (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (car (entsel "\nSelect Transformr Block: "))) "KVA"))
    )
    (if lot
      (progn)
      (setq lot (cdr (assoc 1 (entget (car (entsel "\nSelect Lot Number"))))))
    )       
    (cond
      ((and (eq xfmr "25 KVA") (<= len ###))
        (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "25 KVA") (<= len ###))
        (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "25 KVA") (> len ###))
        (setq wire "ERROR")
      )
      ((and (eq xfmr "50 KVA") (<= len ###))
        (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "50 KVA") (<= len ###))
        (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "50 KVA") (> len ###))
        (setq wire "ERROR")
      )
      ((and (eq xfmr "75 KVA") (<= len ###))
        (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "75 KVA") (<= len ###))
        (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "75 KVA") (> len ###))
        (setq wire "ERROR")
      )
    )
    (if (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: "))))
      (progn
        (LM:vl-setattributevalue blk "FOOTAGE" (strcat (itoa len) "'"))
        (LM:vl-setattributevalue blk "WIRE" wire)
        (LM:vl-setattributevalue blk "LOT_NUM" lot)
      )
    )
    (command "_.Regen")
    (sssetfirst nil (ssadd e))
  )
)
;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

 

Edited May 23, 2022 by mhupp

[bdx]

This looks fantastic @mhupp. I will play around with it today and let you know if I have any issues. Thank you!

[bdx]

I added some placeholder values to the condition statements and I am getting the following error. This is after running the command and selecting the first polyline. I will continue to study the code to understand how it all works, but figured I would share in case it is something obvious to you.

 

Select Polyline; error: bad argument type: lselsetp nil

 

The only values I changed were in the condition statements.

 

(defun C:foo (/ poly len spt pt1 pt2 SST lot SSX xfmr ept wire)
  (while (setq poly (vlax-ename->vla-object (setq e (car (entsel "\nSelect Polyline")))))
    (setq len (+ (* 10 (fix ((if (minusp (vla-get-length poly)) - +) (/ (vla-get-length poly) (float 10)) 0.5))) 15)) ;Lee Mac round to nearest 10' add 15'
    (setq spt (vlax-curve-getStartPoint poly))
    (setq pt1 (mapcar '- spt '(30 30)))
    (setq pt2 (mapcar '+ spt '(30 30)))
    ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window
    (cond
      ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1))
        (setq lot (cdr (assoc 1 (entget (ssname ss 0)))))        
      )
      ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SST) 1))
        (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA"))
      )
    )
    (setq SST nil SSX nil)
    (setq ept (vlax-curve-getendpoint poly))
    (setq pt1 (mapcar '- ept '(30 30)))
    (setq pt2 (mapcar '+ ept '(30 30)))
    ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window
    (cond
      ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SSX) 1))
        (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA"))
      )
      ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1))
        (setq lot (cdr (assoc 1 (entget (ssname ss 0)))))        
      )
    )
    (if xfmr
      (progn)
      (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (car (entsel "\nSelect Transformr Block: "))) "KVA"))
    )
    (if lot
      (progn)
      (setq lot (cdr (assoc 1 (entget (car (entsel "\nSelect Lot Number"))))))
    )       
    (cond
      ((and (eq xfmr "25 KVA") (<= len "50"))
        (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "25 KVA") (<= len "55"))
        (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "25 KVA") (> len "60"))
        (setq wire "ERROR")
      )
      ((and (eq xfmr "50 KVA") (<= len "50"))
        (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "50 KVA") (<= len "55"))
        (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "50 KVA") (> len "60"))
        (setq wire "ERROR")
      )
      ((and (eq xfmr "75 KVA") (<= len "50"))
        (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "75 KVA") (<= len "55"))
        (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "75 KVA") (> len "60"))
        (setq wire "ERROR")
      )
    )
    (if (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: "))))
      (progn
        (LM:vl-setattributevalue blk "FOOTAGE" (strcat (itoa len) "'"))
        (LM:vl-setattributevalue blk "WIRE" wire)
        (LM:vl-setattributevalue blk "LOT_NUM" lot)
      )
    )
    (command "_.Regen")
    (sssetfirst nil (ssadd e))
  )
)
;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

 

[mhupp]

Sorry forgot to add (vl-load-com) this is needed for any function that starts with vl, vla, vlax.  like vla-get-length

 

also had a wrong ss call out.

Dont use quotes in the condition statements that will make them strings not numbers.

 

most polylines in the example drawing are greater then 60 so wire will be error most of the time.

 

(defun C:foo (/ poly e len spt pt1 pt2 SST lot SSX xfmr ept wire)
  (vl-load-com)
  (while (setq poly (vlax-ename->vla-object (setq e (car (entsel "\nSelect Polyline")))))
    (setq len (+ (* 10 (fix ((if (minusp (vla-get-length poly)) - +) (/ (vla-get-length poly) (float 10)) 0.5))) 15)) ;Lee Mac round to nearest 10' add 15'
    (setq spt (vlax-curve-getStartPoint poly))
    (setq pt1 (mapcar '- spt '(30 30)))
    (setq pt2 (mapcar '+ spt '(30 30)))
    ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window
    (cond
      ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1))
        (setq lot (cdr (assoc 1 (entget (ssname SST 0)))))        
      )
      ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SST) 1))
        (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA"))
      )
    )
    (setq SST nil SSX nil)
    (setq ept (vlax-curve-getendpoint poly))
    (setq pt1 (mapcar '- ept '(30 30)))
    (setq pt2 (mapcar '+ ept '(30 30)))
    ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window
    (cond
      ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SSX) 1))
        (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA"))
      )
      ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1))
        (setq lot (cdr (assoc 1 (entget (ssname SST 0)))))        
      )
    )
    (if xfmr
      (progn)
      (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (car (entsel "\nSelect Transformr Block: "))) "KVA"))
    )
    (if lot
      (progn)
      (setq lot (cdr (assoc 1 (entget (car (entsel "\nSelect Lot Number"))))))
    )       
    (cond
      ((and (eq xfmr "25 KVA") (<= len 50))
        (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "25 KVA") (<= len 55))
        (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "25 KVA") (> len 60))
        (setq wire "ERROR")
      )
      ((and (eq xfmr "50 KVA") (<= len 50))
        (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "50 KVA") (<= len 55))
        (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "50 KVA") (> len 60))
        (setq wire "ERROR")
      )
      ((and (eq xfmr "75 KVA") (<= len 50))
        (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "75 KVA") (<= len 55))
        (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "75 KVA") (> len 60))
        (setq wire "ERROR")
      )
    )
    (if (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: "))))
      (progn
        (LM:vl-setattributevalue blk "FOOTAGE" (strcat (itoa len) "'"))
        (LM:vl-setattributevalue blk "WIRE" wire)
        (LM:vl-setattributevalue blk "LOT_NUM" lot)
      )
    )
    (command "_.Regen")
    (sssetfirst nil (ssadd e))
    (mapcar 'set '(poly e len spt pt1 pt2 SST lot SSX xfmr ept wire) '(nil nil nil nil nil nil nil nil nil nil nil nil))
  )
)
;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

 

--Edit also cleared variables at the end so when the command is run multiple times is a start fresh every time.

Edited May 24, 2022 by mhupp

[bdx]

Excellent, I'm no longer getting any errors. I appreciate your work and swift delivery!

 

I do have two comments.

 

1. While I do like the feature that automatically selects the transformer label nearest to the polyline, the inconsistency of it makes the tool a little more difficult to use. It is hard to get in a rhythm for hundreds of lots when this auto select only works half of them.  Therefore, I may comment out those lines or try to find a more reliable selection logic.

2. Due to the maximum wire totals per the conditional statements changing per project, I will need to add a setup prompt as discussed earlier. While I personally have no issue manually updating the values in the lisp editor, I would like to share the program with others who don't know about programming. I think I can figure out how to modify the code to do this with a couple days of research, but if you want to give it a go, I would greatly appreciate it!

 

Ideal Process

1. Run command

...Wire Setup once per project (perhaps I could make some kind of interface for this setup)

2. Type [sw] for wire setup to input maximum wire sizes per transformer (Only needs updated once per project)

3. Prompt User for max length for 25KVA and 1/0 wire, store in variable.

4. Prompt User for max length for 25KVA and 4/0 wire, store in variable.

3. Prompt User for max length for 50KVA and 1/0 wire, store in variable.

4. Prompt User for max length for 50KVA and 4/0 wire, store in variable.

3. Prompt User for max length for 75KVA and 1/0 wire, store in variable.

4. Prompt User for max length for 75KVA and 4/0 wire, store in variable.

5. Exit wire setup

-----------------------

...Transformer Setup once per ~6 lots.

6. Type [st] for transformer size setup

7. Prompt user to select associate transformer label

8. Get transformer size from label

9. Exit transformer setup

-----------------------

10. Select polyline

11. Select label

12. Run conditional statements and update label

-----------------------

 

Edited May 25, 2022 by bdx
typos and cleaned up steps in process

[mhupp]

Basically does what you want.

SW when run for the first time will output this

Max length for 50KVA & 4/0 wire [Not Set]

If you run it again it will have whats inputted.

Max length for 50KVA & 4/0 wire [135]:   (input can be typing a number or using the mouse to select two points)

 

These values will be saved to the drawing using ldata and recalled when foo or sw is run again.

 

if someone tries to run the main program before SW or all xfmr lengths are not set it will ask to run the SW command and exit. 

You might have to edit what the error says to prevent the popup about "quit / exit abort"

 

Didn't do step 6 they way you want it out if spite! no I'm sure their is a easy way to do it but can't figure it out right now and its late.

currently it ask for the size of the transformer and keep that size while the command is active so if you need to switch sizes you have to exit the command.

 

(defun C:SW (/ 25M10 25M40 50M10 50M40 75M10 75M40)
  (or (setq 25M10 (vlax-ldata-get "xfmr" "25M10")) (setq 25M10 "Not Set"))
  (if (setq 25M10 (rtos (getdist (strcat "\nMax length for 25KVA & 1/0 wire [" 25M10 "]: "))2 0))
    (vlax-ldata-put "xfmr" "25M10" 25M10)
  )
  (or (setq 25M40 (vlax-ldata-get "xfmr" "25M40")) (setq 25M40 "Not Set"))
  (if (setq 25M40 (rtos (getdist (strcat "\nMax length for 25KVA & 4/0 wire [" 25M40 "]: "))2 0))
    (vlax-ldata-put "xfmr" "25M40" 25M40)
  )
  (or (setq 50M10 (vlax-ldata-get "xfmr" "50M10")) (setq 50M10 "Not Set"))
  (if (setq 50M10 (rtos (getdist (strcat "\nMax length for 50KVA & 1/0 wire [" 50M10 "]: "))2 0))
    (vlax-ldata-put "xfmr" "50M10" 50M10)
  )
  (or (setq 50M40 (vlax-ldata-get "xfmr" "50M40")) (setq 50M40 "Not Set"))
  (if (setq 50M40 (rtos (getdist (strcat "\nMax length for 50KVA & 4/0 wire [" 50M40 "]: "))2 0))
    (vlax-ldata-put "xfmr" "50M40" 50M40)
  )
  (or (setq 75M10 (vlax-ldata-get "xfmr" "75M10")) (setq 75M10 "Not Set"))
  (if (setq 75M10 (rtos (getdist (strcat "\nMax length for 75KVA & 1/0 wire [" 75M10 "]: "))2 0))
    (vlax-ldata-put "xfmr" "75M10" 75M10)
  )
  (or (setq 75M40 (vlax-ldata-get "xfmr" "75M40")) (setq 75M40 "Not Set"))
  (if (setq 75M40 (rtos (getdist (strcat "\nMax length for 75KVA & 4/0 wire [" 75M40 "]: "))2 ))
    (vlax-ldata-put "xfmr" "75M40" 75M40)
  )
)

(defun C:foo (/ poly len spt pt1 pt2 SST lot SSX xfmr ept wire)
  (defun *error* ()
    (command nil nil nil)
    (if (not (member *error* '("quit / exit abort")))  ;might have to change this to what autocad says
      (princ (strcat "\nError: " *error*))
    )
  )
  (or (setq 25M10 (vlax-ldata-get "xfmr" "25M10")) (setq 25M10 "Not Set"))
  (or (setq 25M40 (vlax-ldata-get "xfmr" "25M40")) (setq 25M40 "Not Set"))
  (or (setq 50M10 (vlax-ldata-get "xfmr" "50M10")) (setq 50M10 "Not Set"))
  (or (setq 50M40 (vlax-ldata-get "xfmr" "50M40")) (setq 50M40 "Not Set"))
  (or (setq 75M10 (vlax-ldata-get "xfmr" "75M10")) (setq 75M10 "Not Set"))
  (or (setq 75M40 (vlax-ldata-get "xfmr" "75M40")) (setq 75M40 "Not Set"))
  (cond
    ((eq 25M10 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
    ((eq 25M40 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    ) 

    ((eq 50M10 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
    ((eq 50M40 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
    ((eq 75M10 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
    ((eq 75M40 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
  ) 
  (initget "25 50 75")
  (setq xfmr (getkword "\nSize of Transformers[25/50/75]: "))
  (while (setq e (car (entsel "\nSelect Polyline")))
    (setq poly (vlax-ename->vla-object e))
    (setq len (+ (* 10 (fix ((if (minusp (vla-get-length poly)) - +) (/ (vla-get-length poly) (float 10)) 0.5))) 15))  ;Lee Mac round lenth up to nearest 10' add 15'
    (setq spt (vlax-curve-getStartPoint poly))
    (setq pt1 (mapcar '- spt '(30 30)))
    (setq pt2 (mapcar '+ spt '(30 30)))
    (if (and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1))
      (setq lot (cdr (assoc 1 (entget (ssname SST 0)))))
    )
    (if lot
      (progn)
      (setq lot (getstring "\nLot Number Not found Please Input: ")) ;this will ask if lot number wasnt found when picking the polyline
    )
    (cond
      ((and (eq xfmr "25") (<= len (read 25M10)))
            (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "25") (<= len (read 25M40)))
            (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "25") (> len (read 25M40)))
            (setq wire "ERROR")
      )
      ((and (eq xfmr "50") (<= len (read 50M10)))
            (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "50") (<= len (read 50M40)))
            (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "50") (> len (read 50M40)))
            (setq wire "ERROR")
      )
      ((and (eq xfmr "75") (<= len (read 75M10)))
            (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "75") (<= len (read 75M40)))
            (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "75") (> len (read 75M40)))
            (setq wire "ERROR")
      )
    )
    (if (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: "))))
      (progn
        (LM:vl-setattributevalue blk "FOOTAGE" (strcat (itoa len) "'"))
        (LM:vl-setattributevalue blk "WIRE" wire)
        (LM:vl-setattributevalue blk "LOT_NUM" lot)
      )
    )
    (sssetfirst nil (ssadd e))
    (mapcar 'set '(poly e len spt pt1 pt2 SST lot SSX ept wire) '(nil nil nil nil nil nil nil nil nil nil nil))
  )
  (princ)
)
;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:vl-getattributevalue (blk tag)
  (setq tag (strcase tag))
  (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue (blk tag val)
  (setq tag (strcase tag))
  (vl-some
    '(lambda (att)
       (if (= tag (strcase (vla-get-tagstring att)))
         (progn
           (vla-put-textstring att val) val
         )
       )
     )
    (vlax-invoke blk 'getattributes)
  )
)

 

Edited May 26, 2022 by mhupp
update code

[bdx]

Woah.. that was fast. This looks perfect! I haven't been able to test it yet because I'm getting another error in the visual lisp editor.  I skimmed through the code and don't see any obvious extra parenthesis.

 

Do you have cash app? I would like toss a few bucks your way in appreciation of your time.

Edited May 26, 2022 by bdx

[BIGAL]

Maybe this line. To many closing brackets.

 

(setq lot (getstring "\nLot Number Not found Please Input: "))

[mhupp]

11 minutes ago, BIGAL said:

Maybe this line. To many closing brackets.

 

(setq lot (getstring "\nLot Number Not found Please Input: "))

 

that's it i replaced

(setq lot (cdr (assoc 1 (entget (car (entsel "\nSelect Lot Number"))))))

To just ask for a number rather then selecting text if it wasn't found.

Edited May 26, 2022 by mhupp

[mhupp]

1 hour ago, bdx said:

Do you have cash app? I would like toss a few bucks your way in appreciation of your time.

 

If your going to give me money  I will have to switch SW to work with a DCL file.

 

(defun C:SW (/ 25M10 25M40 50M10 50M40 75M10 75M40)
  (or (setq 25M10 (vlax-ldata-get "xfmr" "25M10")) (setq 25M10 "Not Set"))
  (or (setq 25M40 (vlax-ldata-get "xfmr" "25M40")) (setq 25M40 "Not Set"))
  (or (setq 50M10 (vlax-ldata-get "xfmr" "50M10")) (setq 50M10 "Not Set"))
  (or (setq 50M40 (vlax-ldata-get "xfmr" "50M40")) (setq 50M40 "Not Set"))
  (or (setq 75M10 (vlax-ldata-get "xfmr" "75M10")) (setq 75M10 "Not Set"))
  (or (setq 75M40 (vlax-ldata-get "xfmr" "75M40")) (setq 75M40 "Not Set"))
  (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
  (write-line "Table : dialog { label = \"Maximum Distances for Transformers\";" fo)
  (write-line " : edit_box {label = \"25KVA and 1/0 wire\"; key = \"25M10\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo)
  (write-line " : edit_box {label = \"25KVA and 4/0 wire\"; key = \"25M40\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo)
  (write-line " : edit_box {label = \"50KVA and 1/0 wire\"; key = \"50M10\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo)
  (write-line " : edit_box {label = \"50KVA and 4/0 wire\"; key = \"50M40\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo)
  (write-line " : edit_box {label = \"75KVA and 1/0 wire\"; key = \"75M10\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo)
  (write-line " : edit_box {label = \"75KVA and 4/0 wire\"; key = \"75M40\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo)
  (write-line " ok_only;" fo)
  (write-line "}" fo)
  (close fo)
  (new_dialog "Table" (setq d (load_dialog fn)))
  ; Set Dialog Initial Settings
  (set_tile "25M10" 25M10)
  (set_tile "25M40" 25M40)
  (set_tile "50M10" 50M10)
  (set_tile "50M40" 50M40)
  (set_tile "75M10" 75M10)
  (set_tile "75M40" 75M40)
  (action_tile "25M10" "(vlax-ldata-put \"xfmr\" \"25M10\" $value)")
  (action_tile "25M40" "(vlax-ldata-put \"xfmr\" \"25M40\" $value)")
  (action_tile "50M10" "(vlax-ldata-put \"xfmr\" \"50M10\" $value)")
  (action_tile "50M40" "(vlax-ldata-put \"xfmr\" \"50M40\" $value)")
  (action_tile "75M10" "(vlax-ldata-put \"xfmr\" \"75M10\" $value)")
  (action_tile "75M40" "(vlax-ldata-put \"xfmr\" \"75M40\" $value)")
  (start_dialog)
  ; Unload Dialog
  (unload_dialog d)
  (vl-file-delete fn)
  (princ)
)
(defun C:foo (/ poly len spt pt1 pt2 SST lot SSX xfmr ept wire)
  (defun *error* ()
    (command nil nil nil)
    (if (not (member *error* '("quit / exit abort")))  ;might have to change this to what autocad says
      (princ (strcat "\nError: " *error*))
    )
  )
  (or (setq 25M10 (vlax-ldata-get "xfmr" "25M10")) (setq 25M10 "Not Set"))
  (or (setq 25M40 (vlax-ldata-get "xfmr" "25M40")) (setq 25M40 "Not Set"))
  (or (setq 50M10 (vlax-ldata-get "xfmr" "50M10")) (setq 50M10 "Not Set"))
  (or (setq 50M40 (vlax-ldata-get "xfmr" "50M40")) (setq 50M40 "Not Set"))
  (or (setq 75M10 (vlax-ldata-get "xfmr" "75M10")) (setq 75M10 "Not Set"))
  (or (setq 75M40 (vlax-ldata-get "xfmr" "75M40")) (setq 75M40 "Not Set"))
  (cond
    ((eq 25M10 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
    ((eq 25M40 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    ) 

    ((eq 50M10 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
    ((eq 50M40 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
    ((eq 75M10 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
    ((eq 75M40 "Not Set")
      (prompt "\nTransformer Distances not set Please run code: SW")
      (quit)
    )
  ) 
  (initget "25 50 75")
  (setq xfmr (getkword "\nSize of Transformers[25/50/75]: "))
  (while (setq e (car (entsel "\nSelect Polyline")))
    (setq poly (vlax-ename->vla-object e))
    (setq len (+ (* 10 (fix ((if (minusp (vla-get-length poly)) - +) (/ (vla-get-length poly) (float 10)) 0.5))) 15))  ;Lee Mac round lenth up to nearest 10' add 15'
    (setq spt (vlax-curve-getStartPoint poly))
    (setq pt1 (mapcar '- spt '(30 30)))
    (setq pt2 (mapcar '+ spt '(30 30)))
    (if (and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1))
      (setq lot (cdr (assoc 1 (entget (ssname SST 0)))))
    )
    (if xfmr
      (progn)
      (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (car (entsel "\nSelect Transformr Block: "))) "KVA"))
    )
    (if lot
      (progn)
      (setq lot (cdr (assoc 1 (entget (car (entsel "\nSelect Lot Number"))))))
    )
    (cond
      ((and (eq xfmr "25") (<= len (read 25M10)))
            (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "25") (<= len (read 25M40)))
            (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "25") (> len (read 25M40)))
            (setq wire "ERROR")
      )
      ((and (eq xfmr "50") (<= len (read 50M10)))
            (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "50") (<= len (read 50M40)))
            (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "50") (> len (read 50M40)))
            (setq wire "ERROR")
      )
      ((and (eq xfmr "75") (<= len (read 75M10)))
            (setq wire "WIRE 1/0")
      )
      ((and (eq xfmr "75") (<= len (read 75M40)))
            (setq wire "WIRE 4/0")
      )
      ((and (eq xfmr "75") (> len (read 75M40)))
            (setq wire "ERROR")
      )
    )
    (if (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: "))))
      (progn
        (LM:vl-setattributevalue blk "FOOTAGE" (strcat (itoa len) "'"))
        (LM:vl-setattributevalue blk "WIRE" wire)
        (LM:vl-setattributevalue blk "LOT_NUM" lot)
      )
    )
    (sssetfirst nil (ssadd e))
    (mapcar 'set '(poly e len spt pt1 pt2 SST lot SSX xfmr ept wire) '(nil nil nil nil nil nil nil nil nil nil nil nil))
  )
  (princ)
)
;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:vl-getattributevalue (blk tag)
  (setq tag (strcase tag))
  (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue (blk tag val)
  (setq tag (strcase tag))
  (vl-some
    '(lambda (att)
       (if (= tag (strcase (vla-get-tagstring att)))
         (progn
           (vla-put-textstring att val) val
         )
       )
     )
    (vlax-invoke blk 'getattributes)
  )
)

 

Edited May 26, 2022 by mhupp

[bdx]

Haha, awesome! The program is already better than I expected. I didn't realize it was adding the lot # to the label as well. I thought I would have to use NUMINC.lsp for that.

 

I can't pay you the rate you can probably charge for this work, but I would like to at least buy you a few drinks!

Edited May 26, 2022 by bdx

[mhupp]

5 minutes ago, bdx said:

Haha, awesome! The program is already better than I expected. I didn't realize it was adding the lot # to the label as well. I thought I would have to use NUMINC.lsp for that.

I can't pay you the rate you can probably charge for this work, but I would like to at least buy you a few drinks!

 

No need but if you really want to give someone money maybe donate to @CADTutor to help with upkeep.

 

Quote

If you find this site useful, you might like to consider making a donation. All content on this site is provided free of charge and we hope to keep it that way. However, running a site like CADTutor does cost money and you can help to improve the service and to guarantee its future by donating a small amount. We guess that you probably wouldn't miss $5.00 but it would make all the difference to us.

https://www.paypal.com/webapps/shoppingcart?flowlogging_id=f4665218b5343&mfid=1653580133615_f4665218b5343

[bdx]

"A gentleman and a scholar!" I will definitely help support this great community.