LISP to move field to attribute and autonumbering the block

[Davide]

Hi to everyone,

I´m a "new old" user here. I just  forgOt my old user name my last visit here was in 2008, I think.

I started working again with AutoCAD for BOM in civil building.
Now I need a big help.

 

Starting from the LISP of Lee MAC, "MidLen V1-1.lsp", I need  the value of the generated field, which contains the length of an object, to be directly written in an attribute (contained in a block, of course) AND, at the same time, to increment the number of another attribute, of the same block, to recognize univocally the object (the length). At the end, after selection of the lines, must be generated one block for each, numbered univocally with the length of the line.

 

The example attached can have anoter design, just with two attribute, no graphics.

 

I know there is a LISP called "LengthFieldToAttribute V1-0.lsp", but you have to pick each line and pick the attribute in the block to write the value in it.

Best regards to you all, addictet, like me, to AutoCAD.

Davide

Am Wald - Blocco piccolo r4.dwg

[BIGAL]

A very easy question two ways using tag names or easier attribute order to put answers. 

 

Only reason no code is yes pick all lines and do it BUT where do we put the block ? Middle of line etc. At an angle ? 

 

Edited September 16, 2019 by BIGAL

[Davide]

Hi BIGAL,

thankyou for the answer.

 

I need to put the block at the middle of line, aligned to the line. But it is not so important.

 

Important is that each line is associated to the block with the measurement of line in the attribute, contained the field, AND an univoque incremental number in another attribute of the block (please not handle).

 

For example, it could be used in conjunction the skills of Numinc Lisp with the MidLen Lisp :

1. Select a name to be incremented, for univoque name (using the features of Numinc.lsp http://www.lee-mac.com/numinc.html)

2. Select the lines to populated the blocks with the length (using the code of MidLen.lsp http://www.lee-mac.com/midlen.html)

 

3. For the output: to export the value in excel, I use MacAtt.lsp (http://www.lee-mac.com/macatt.html)

 

Consider that the same new suite, could be used also for areas...

 

 

See attachment for better understanding.

 

Ciao, have a nice day,

Davide

 

P.S. Please consider my english... I translate my thoughs from italian to english, and the construction of phrases could appear confused for you!

Am Wald - MIDLEN + BLOCK.dwg

[BIGAL]

Here is a start for you, needs readability added. Block must exist.

 

; By alanh 2019

See last post for final version

Edited September 22, 2019 by BIGAL

[Davide]

1 hour ago, BIGAL said:

Here is a start for you, needs readability added. Block must exist.

 

 

; By alanh 2019

 

(defun numblkattnum ( / ss2 obj att )

(setq num 0)
(setq ss2 (ssget "x" (list (cons 0 "insert")(cons 2 "_AufMass_FEW"))))
(repeat (setq x (sslength ss2))
(setq obj (vlax-ename->vla-object (ssname ss2 (setq x (- x 1)))))
(setq att (nth 0 (vlax-invoke obj 'getattributes)))
(setq attnum (atoi (vla-get-textstring att)))
(if (> attnum num)(setq num attnum))
)
)

(defun c:numblklen ( / oldaunits ss obj len ang dist stpt endpt val1 val2 attnum)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(if (= attnum nil)(numblkattnum))
(setq attnum (+ attnum 1))
(setq ss (ssget (list (cons 0 "line"))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq stpt  (vlax-safearray->list (vlax-variant-value(vla-get-startpoint obj))))
(setq endpt  (vlax-safearray->list (vlax-variant-value(vla-get-endpoint obj))))
(setq len (vla-get-length obj))
(setq ang (angle stpt endpt))
(setq dist (/ (distance stpt endpt)2.0))
(setq stpt (polar stpt ang dist))
(setq val1 (rtos attnum 2 0))
(setq val2 (rtos len 2 2))
(command "-insert" "_AufMass_FEW" stpt 1 1 ang val1 val2 "0.0" )
(setq attnum (1+ attnum))
)
(setvar 'aunits oldaunits)
)

 

Hi Bigal,

thankyou for the code. I´ve tested, but it doesn't work.

And I don't know what do you mean for "needs readability added."

 

This is the command-line output, for one line selected (the output is the same if you select more than one line at time, repeating for each item):

 

Command: NUMBLKLEN
Select objects: 1 found
Select objects:  -insert Enter block name or [?] <_AufMass_FEW>: _AufMass_FEW
Units: Unitless   Conversion:      1.00
Specify insertion point or [Basepoint/Scale/X/Y/Z/Rotate]:
Enter X scale factor, specify opposite corner, or [Corner/XYZ] <1>: 1 Enter Y scale factor <use X scale factor>: 1
Specify rotation angle <0r>: 0
Command: 1 Unknown command "1".  Press F1 for help.
Command: 2.6 Unknown command "6".  Press F1 for help.
Command: 0.0 Unknown command "0".  Press F1 for help.
Command: 0

 

You can see the result in the attached file.

Ciao,

Davide

 

Am Wald - MIDLEN + BLOCK Output NO.dwg

[BIGAL]

The code has two defuns and both must be loaded. Just tested on your last dwg worked perfect except have to add flip block for readability as I already said. Just making sure 1st it was what you wanted.

 

Second question is do you change the shape so want a true field expression so will update length.

 

[Davide]

2 hours ago, BIGAL said:

The code has two defuns and both must be loaded. Just tested on your last dwg worked perfect except have to add flip block for readability as I already said. Just making sure 1st it was what you wanted.

 

Second question is do you change the shape so want a true field expression so will update length.

 

 

Hi Bigal,

again, thank you.

 

"The code has two defuns and both must be loaded."

I'm sorry, but I don't know how to load the two defuns.

 

"except have to add flip block for readability as I already said."

For readability of text, for me it is not so important, because I need the output in excel.

 

"Second question is do you change the shape so want a true field expression so will update length."

And yes, I need a field for the length.

 

Meanwhile, I try to understand how to load defuns, and If someone who read this thread could explain how to load defuns, I'll appreciate it.

 

Cheers,

Davide

[BIGAL]

Just copy and paste  the code to notepad then save as say numblklen.lsp.

 

Add (c:numblklen) as vary last line then will run 1st time automatically.

 

You can drag and drop from explorer, use Appload or a menu to load. Once loaded can be run again by typing numblklen.

 

Will add the field function.

 

The 1st defun checks the last number used, 

[BIGAL]

Try this

 

Update position as a manual approach much easier than using a reactor. Need multi radio buttons.lsp for choice.

 

; By alanh 2019
; uses block with 3 atts _AufMass_FEW
; 2nd att is length as field

(defun numblkattnum ( / ss2 obj att )
(setq num 0)
(setq ss2 (ssget "x" (list (cons 0 "insert")(cons 2 "_AufMass_FEW"))))
(if (= ss2 nil)
(progn
(princ "no blocks exist")
(alert (strcat "last number is " (rtos (setq attnum num) 2 0)))
)
(progn
(repeat (setq x (sslength ss2))
(setq obj (vlax-ename->vla-object (ssname ss2 (setq x (- x 1)))))
(setq att (nth 0 (vlax-invoke obj 'getattributes)))
(setq attnum (atoi (vla-get-textstring att)))
(if (> attnum num)(setq num attnum))
)
)
)
(alert (strcat "last number is " (rtos (setq attnum num) 2 0)))
(princ)
)

(defun numblklen ( / oldaunits ss obj len ang dist stpt endpt val1 val2 attnum)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(if (= attnum nil)(numblkattnum))
(setq attnum (+ attnum 1))
(setq ss (ssget (list (cons 0 "line"))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq stpt  (vlax-safearray->list (vlax-variant-value(vla-get-startpoint obj))))
(setq endpt  (vlax-safearray->list (vlax-variant-value(vla-get-endpoint obj))))
(setq atlength (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid obj)) ">%).Length \\f \"" "%lu2%pr3"  "\">%"))
(setq ang (angle stpt endpt))
(setq dist (/ (distance stpt endpt)2.0))
(setq stpt (polar stpt ang dist))
(setq val1 (rtos attnum 2 0))
(command "-insert" "_AufMass_FEW" stpt 1 1 ang "" "" "")
(setq obj2 (vlax-ename->vla-object (entlast)))
(setq att (vlax-invoke obj2 'getattributes))
(vla-put-textstring (nth 0 att) val1)
(vla-put-textstring (nth 1 att) atlength)
(setq attnum (1+ attnum))
)
(setvar 'aunits oldaunits)
(command "regen")
(princ)
)


(defun moveblkum ( / adoc stpt endpt aobj objid oldaunits oldsnap)
(setq aDoc (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(setq ss (ssget "x" (list(cons 0 "insert")(cons 2 "_AufMass_FEW"))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq ins (vlax-get obj 'insertionpoint))
(setq atts  (vlax-invoke obj 'getattributes))
(setq att (nth 1 atts))
(setq dict (vlax-vla-object->ename (vla-GetExtensionDictionary att)))
(setq flst (entget (cdr (assoc 360 (entget (cdr (last (dictnext dict "ACAD_FIELD"))))))))
(setq objid (vla-get-ObjectId (vlax-ename->vla-object (cdr (assoc 331 flst)))))
(setq aObj (vla-ObjectIDToObject aDoc ObjId))
(setq stpt (vlax-get aobj 'startpoint))
(setq endpt (vlax-get aobj 'endpoint))
(setq ang (angle stpt endpt))
(setq dist (/ (distance stpt endpt)2.0))
(setq stpt (polar stpt ang dist))
(vlax-put obj 'insertionpoint stpt)
(vlax-put obj 'rotation ang)
)
(alert "location updated")
(setvar 'osmode oldsnap)
(setvar 'aunits oldaunits)
(princ)
)

(defun c:linelens ( / ans)
(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (= but nil)(setq but 1))
(setq ans (ah:butts but "V"  '("Please choose     " "Last number" "New" "Update location")))
(cond
((= ans "Last number")(numblkattnum))
((= ans "New")(numblklen))
((= ans "Update location")(moveblkum))
)
)

(c:linelens)

 

Multi radio buttons.lsp

Edited September 20, 2019 by BIGAL

[Davide]

Ciao Bigal,

yesterday I'we tested the lisp without Radio Button, and it works!!!

See the attachment.

 

The new version with radio button have some problem: after giving the path to autoload "Multi Radio Button.lsp", the new "numblklen.lsp" work only once and, at every instance is going to write the length of line in the block, appear the GUI for the "Appload" command. With the "ESC" (escape button), the routine works anyway, and as told, write the block, but, at the end the command "numblklen" is not more available.

 

Summing up:

1. The lisp "numblklen v2.1"  in attachment works

2. The last version above "numblklen v3.1", works, but only one time and you have to click the "ESC" button for every line you have selected. Maybe it's depend from my computer. Hi give me some problems - even it's only one month old - with Autocad... I think something with the Noun/verb selection.

 

Only one think to mention: I have modified the field expression in the 2nd lisp version (the one without Radio Button) with the one of the 3rd. In fact, your last version use a different field expression that write only 3 number after the comma.

I think it will be bettere if the field will use the precision according to DDUNITS.

 

See the 3 version of numblklen.lsp in attachment. Version 2.2 is the 2.1 with the string for field of version 3.1.

And in the .dwg you can see the result of "numblklen.lsp". I know that it´s look a litte messy, but I need the output in excel.

For your info, I've tested the lisp with a block with more than 3 tags, and it work.

 

P.S.

I think that this lisp could be inplemented with the option of get also the area and the volume.

Another features could be to choose wich block to use and the tag where to write in.

 

Thank you, grazie .

Davide

 

numblklen v2.2 - WORK with 3 NUMBR after COMMA (CHANGE TAG NAME - BIGAL CADTUTOR).lsp numblklen v3.1 (BIGAL with RADIO BUTTON).lsp numblklen v2.1 - WORK (CHANGE TAG NAME - BIGAL CADTUTOR).lsp Am Wald - Aufmass for BIGAL.dwg

Edited September 20, 2019 by Davide
just typing error

[BIGAL]

Answer last question 1st it becomes a lot more complex to select a block and which attribute to update, its a case of just using the correct block tag name. Getting Area of lines is a lot harder than plines. Labelling plines and lines using a block would be a further enhancement.

 

I will go through your dwgs I randomly made lines and it worked for as many as I created and ran it in multiple tests by typing Linelens on command line.

 

The last thing is people like me provide code for free so some times at some point we stop adding functions. I am more than happy to help you learn, there are plenty of others that will help also. So have a go at making some of the modifications, start with (getvar 'luprec) not ddunits

Edited September 22, 2019 by BIGAL

[BIGAL]

The code is working within the limits of your 1st post isolate the layers and make sure the correct block exists. This is 53 items in one go. Just type "Linelens"