Hi
Endloses thema...
ein primitiver superkurzer superharter crashkurs:
Ein filter hat normalerweise folgenden aufbau:
Einmal durch alle elemente laufen und dann ggf die eigenschaften anpassen.
Der VBA editor hilft dir wenn du entity. eingibst was du alles aendern kannst. - Mit dem entity.
Weiter unten mappe ich das entity auf eine blockreferenz (Set blockref = entity),
nun kannst du bei blockref. guggen was das blockref so alles tolles kann.
Die namensregeln sind einfach
ACAD[linie polyline circle...] fuer den elementtyp
und ACDB[linie polyline circle...] fuer die fallunterscheidung was es denn nun ist. Da ich mir nie merken kann wie die das nun gross oder kleinschreiben "AcDbBlockReference" wandel ich das in kleinbuchstaben um -dann gibts da schon mal keine fragen mehr 
Logisch das man regeln aufstellen will wie wo was umbenannt etc werden soll.
Variante 1 fuer jede Firma eine dvb - Variante 2 irgendetwas was die umwandlungsdaten vorhaellt.
Ascci text file
Excel file
accessdb
Der moeglichkeiten sind endlos wie ebenso der Programmiersprachen.
klar das geht mit lisp auch, nur - wer spricht lisp ?
OK ACAD, EMACS, THE GIMP, - nur da hoert dann auch auf.
Wer spricht .net, VBA ?
Excel, Word, Access, Powerploint, Oratzle, ... (sehr lange Liste)
Also entweder schnell tapfer in VBA coden oder .Net anwerfen.
Alternativ - den software developer des vertrauens...
LG aus Finnland
Thomas
sub cleanmeup()
dim entity as acadentity
dim blockref as acadblockreference
for each layer in thisdrawing.layers
layer.name=replace(layer.name,"VollPfosten","Halbpfosten")
next
for each entity in thisdrawing.modelspace
if entity.color acred then entity.clor =acblue
if entity.layer = "Vollpfosten" then entity.layer = "Halbpfosten"
'ich will gruen !
entity.color = acgreen
next
for each entity in thisdrawing.modelspace
select case lcase(entity.objectname)
case "acdbblockreference"
set blockref=entity
blockref.name=replace(blockref.name,"VollPfosten","Halbpfosten")
case "acdbtext" 'nicht behandelt
debug.print "wer brauch das"
case else
debug.print "nicht behandelt" 'und das kenne ich sowieso nicht
end select
next
end sub
OK dimension lines - schickes thema ...
Die sind wirklich uebel. Glaub die haben per se so um die 160 Einstellungsmoeglichkeiten.
(Werden nur von Tabellen geschlagen).
Un um es perfekt zu machen, kann man die auch nicht wirklich direkt addressieren.
Als Kickstarter folgende routine.
Maskettenen haben zumindest 3 oder 4 Farbwerte da gilt es die entsprechenden Variablen zu finden oder zu ergooglen.
Public Sub UgDimStyle_CreateNew(Optional ByVal sDimStyName As String = "Standard_Dim")
'------------------------------------------------------------------------------
'
'
'------------------------------------------------------------------------------
Dim CurDimStyle As AcadDimStyle
Dim newdimstyle As AcadDimStyle
Dim iAltUnits As Integer
Dim ddimscale As Double
'''''''''''''''''''''''''''''''''''''''
'Save copy of current dimstyle
Set CurDimStyle = ThisDrawing.ActiveDimStyle
'Create new dimstyle
Set newdimstyle = ThisDrawing.dimstyles.Add(sDimStyName)
'Set newly created dimstyle current
ThisDrawing.ActiveDimStyle = newdimstyle
'Save the target "dimvar" values
ddimscale = ThisDrawing.GetVariable("Dimscale")
iAltUnits = ThisDrawing.GetVariable("Dimalt")
'------------------------------------------------------------------------------
'Alter the target "dimvar" values
'------------------------------------------------------------------------------
ThisDrawing.SetVariable "DIMSCALE", 1# 'will control size of dim text
ThisDrawing.SetVariable "DIMASZ", 2.5 'arrowhead size
ThisDrawing.SetVariable "DIMATFIT", 2 'arrow-text arrangement
ThisDrawing.SetVariable "DIMAZIN", 3 '0 suppression before/after angular
ThisDrawing.SetVariable "DIMBLK", "" 'special arrow blk
ThisDrawing.SetVariable "DIMDLE", 0 'dim line extension past extension
ThisDrawing.SetVariable "DIMDLI", 10 'dist between baseline dims
ThisDrawing.SetVariable "DIMDSEP", "." 'decimal separator
ThisDrawing.SetVariable "DIMEXE", 1 'dim line extension past extension
ThisDrawing.SetVariable "DIMEXO", 1 'dim offset from origin
ThisDrawing.SetVariable "DIMFIT", 5 'control fit if not enough space
ThisDrawing.SetVariable "DIMGAP", 2 'gap around text
ThisDrawing.SetVariable "DIMJUST", 0 'text placement - above centered
ThisDrawing.SetVariable "DIMLFAC", 1# 'length scaling
ThisDrawing.SetVariable "DIMTAD", 1 'text to dim placement - above
ThisDrawing.SetVariable "DIMTIH", 0 'aligned with dim
ThisDrawing.SetVariable "DIMTIX", 0 'force inside
ThisDrawing.SetVariable "DIMTMOVE", 0 'dim moves with text
ThisDrawing.SetVariable "DIMTSZ", 0 'draw arrowheads
ThisDrawing.SetVariable "DIMTXT", 3.5 'text height
ThisDrawing.SetVariable "DIMTZIN", 12 '0 suppression before/after tol
ThisDrawing.SetVariable "DIMUNIT", 2 'unit format - decimal
ThisDrawing.SetVariable "DIMZIN", 12 '0 suppression before/after
'Copy new document dimvar settings into new dimstyle
newdimstyle.CopyFrom ThisDrawing
'Set original dimstyle current
'ThisDrawing.ActiveDimStyle = CurDimStyle
'Restore the altered "dimvar" values
''ThisDrawing.SetVariable "Dimscale", dDimScale
''ThisDrawing.SetVariable "Dimalt", iAltUnits
'Copy restored document dimvar settings into original dimstyle
''CurDimStyle.CopyFrom ThisDrawing
Set CurDimStyle = Nothing
Set newdimstyle = Nothing
End Sub
------------------
Wer es nicht versucht, hat schon verlorn
Und bei 3 Typos gibts den vierten gratis !
[Diese Nachricht wurde von rexxitall am 15. Jul. 2013 editiert.]
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
