add area to attributs of block

[Anonymous]

hi
i want know how to add area value of close polyline to attribute of block.
think you

[Anonymous]

billy del casa wrote: > hi > i want know how to add area value of close polyline to attribute of block. > think you I have one for lisp if you like. This routine you select the closed polyline then pick the Drainage area block to insert the area in Acres into the block. you can change the name and the attribute to suit your needs. (defun c:acb (/) (setq OS (getvar "osmode")) (setvar "osmode" 512) (while (/= (cdr (assoc 0 (entget (car (setq ENT (entsel "\nSelect Polygon ")))))) "LWPOLYLINE")) (redraw (car ent) 3) (setvar "osmode" OS) (command ".area" "e" ENT) (setq Area (getvar "area")) (setq Acre 43560) (setq a (/ area acre)) (princ " ") (princ a) (princ " Acres ") (princ area) (princ " S.F.") (princ) (while (/= (cdr (assoc 2 (entget (setq ename1 (car (entsel "\nPick block")))))) "DS Draiange area Marker")) (setq ename2 ename1) (while (/= (cdr (assoc 2 (entget (setq ename1 (entnext ename1))))) "AREA_IN_ACRES")) (setq ent1 (entget ename1)) (entmod (subst (cons 1 (rtos a 2)) (assoc 1 ent1) ent1)) (entupd ename2) (redraw (car ent) 4) (princ) )

[Speed_CAD]

Hi...

I did this routine 😉 to VB

Private Sub AreaPolyAtr()
Dim AreaPol As String
Dim objsel As AcadLWPolyline
Dim pnt As Variant
Dim enTipo As String
Dim coordenadas As Variant
Dim Atributo As AcadAttribute
Dim I As Integer
Dim xl, yl, zl
Dim xyz As Integer
Dim X, Y
Dim coor
Dim punto(0 To 2) As Double
Dim Bloque As AcadBlock
Dim RefBloque As AcadBlockReference
xl = 0: yl = 0: zl = 0: xyz = 2
On Error Resume Next
Err.Clear
utilGet.GetEntity objsel, pnt, vbCr & "Seleccione Polilínea: "
enTipo = objsel.ObjectName
If enTipo = "AcDbPolyline" Then
coordenadas = objsel.Coordinates
For I = LBound(coordenadas) To UBound(coordenadas)
If (I - (xyz * (Fix(I / xyz)))) = 0 Then
xl = xl + coordenadas(I)
End If
If (I - (xyz * (Fix(I / xyz)))) = 1 Then
yl = yl + coordenadas(I)
End If
If (I - (xyz * (Fix(I / xyz)))) = 2 Then
zl = zl + coordenadas(I)
End If
Next I
AreaPol = "Area: " & Format(objsel.Area, "0.000")
X = xl / ((UBound(coordenadas) + 1) / xyz)
Y = yl / ((UBound(coordenadas) + 1) / xyz)
punto(0) = 0: punto(1) = 0: punto(2) = 0
Set Bloque = acadDoc.Blocks.Add(punto, objsel.Handle)
punto(0) = 0: punto(1) = 0: punto(2) = 0
Set Atributo = Bloque.AddAttribute(4.5, acAttributeModeVerify, "AREA:", punto, "A", AreaPol)
punto(0) = 0: punto(1) = 0: punto(2) = 0
Atributo.Alignment = acAlignmentMiddle
Atributo.TextAlignmentPoint = punto
Set RefBloque = acadDoc.ModelSpace.InsertBlock(punto, objsel.Handle, 1, 1, 1, 0)
punto(0) = X: punto(1) = Y: punto(2) = 0
RefBloque.InsertionPoint = punto
Else
MsgBox "Debe seleccionar una polilinea."
End If
End Sub

Un saludo de SpeedCAD... 🙂
CHILE
FORO: http://www.hispacad.com/foro

[Anonymous]

think you four your help, but i have always the problem.
j'ai executé le programme en VB mais ça n'a pas marché. si c'est possible vous m'ecrirez les etapes pas à pas(step by step) dés la creation du bloc avec l'attribut surface (area) jusqu'à le calcul et l'affichage de cette surface par autocad.
think you

[Speed_CAD]

Hi...

You talk in English please...

[Anonymous]

Babel Fish Translation In English: I have executed the program in VB but ?? does not have ??. if it is possible will you write the stages not ?? pas(step by step) ?? the creation of the block with the attribute surfaces (area) until ?? the calculation and the posting of this surface by autocad. SpeedCAD wrote: > > Hi... > > You talk in English please... -- Anne Brown Discussion Groups Administrator Autodesk, Inc.

[Anonymous]

Here is the translation:
I ran the program in VB but it didn't work. If possible could you write it step by step from the block creation with the area attribut up to the calculation and printing of this surface by Autocad.

[Anonymous]

Drummond's translation is perfect.There is someone who speaks English-French or French-English ( as you prefer) at last 😉

[Speed_CAD]

Thanks Drummond...

Ok, First you reference to AutoCAD 2000 Type Library or AutoCAD 2004 Type Library. Next:

Option Explicit

Private autocadApp As AcadApplication
Private utilGet As AcadUtility
------------------------------------------------------------------------

Private Sub Form_Load()
Set autocadApp = GetObject(, "Autocad.Application.15")
'If AutoCAD 2004 then
'Set autocadApp = GetObject(, "Autocad.Application.16")
Set utilGet = autocadApp.ActiveDocument.Utility
End Sub
------------------------------------------------------------------------

Private Sub AreaPolyAtr()
Dim AreaPol As String
Dim objsel As AcadLWPolyline
Dim pnt As Variant
Dim enTipo As String
Dim coordenadas As Variant
Dim Atributo As AcadAttribute
Dim I As Integer
Dim xl, yl, zl
Dim xyz As Integer
Dim X, Y
Dim coor
Dim punto(0 To 2) As Double
Dim Bloque As AcadBlock
Dim RefBloque As AcadBlockReference
xl = 0: yl = 0: zl = 0: xyz = 2
On Error Resume Next
Err.Clear
utilGet.GetEntity objsel, pnt, vbCr & "Seleccione Polilínea: "
enTipo = objsel.ObjectName
If enTipo = "AcDbPolyline" Then
coordenadas = objsel.Coordinates
For I = LBound(coordenadas) To UBound(coordenadas)
If (I - (xyz * (Fix(I / xyz)))) = 0 Then
xl = xl + coordenadas(I)
End If
If (I - (xyz * (Fix(I / xyz)))) = 1 Then
yl = yl + coordenadas(I)
End If
If (I - (xyz * (Fix(I / xyz)))) = 2 Then
zl = zl + coordenadas(I)
End If
Next I
AreaPol = "Area: " & Format(objsel.Area, "0.000")
X = xl / ((UBound(coordenadas) + 1) / xyz)
Y = yl / ((UBound(coordenadas) + 1) / xyz)
punto(0) = 0: punto(1) = 0: punto(2) = 0
Set Bloque = acadDoc.Blocks.Add(punto, objsel.Handle)
punto(0) = 0: punto(1) = 0: punto(2) = 0
Set Atributo = Bloque.AddAttribute(4.5, acAttributeModeVerify, "AREA:", punto, "A", AreaPol)
punto(0) = 0: punto(1) = 0: punto(2) = 0
Atributo.Alignment = acAlignmentMiddle
Atributo.TextAlignmentPoint = punto
Set RefBloque = acadDoc.ModelSpace.InsertBlock(punto, objsel.Handle, 1, 1, 1, 0)
punto(0) = X: punto(1) = Y: punto(2) = 0
RefBloque.InsertionPoint = punto
Else
MsgBox "Debe seleccionar una polilinea."
End If
End Sub
------------------------------------------------------------------------

Private Sub CommandButton_Click()
AppActivate autocadApp.Caption
AreaPolyAtr
Me.Show
End Sub

Is All

Un saludo de SpeedCAD... 🙂
CHILE
FORO: http://www.hispacad.com/foro