Search the Community

(defun c:awz ( / sUndo enx atent atent_list) (setq sUndo (vlax-invoke (vla-get-ActiveDocument (vlax-get-acad-object)) 'StartUndoMark)) (setvar 'errno 0) (while (/= 52 (getvar 'errno)) (setvar 'errno 0) (setq atent (car (nentsel "\nSelect multiline attribute to change Defined Width to 0: "))) (cond ( (= 7 (getvar 'errno)) (prompt "\nNothing Selected.") ) ( (null atent) (prompt "\nExit.") ) ( (/= "ATTRIB" (cdr (assoc 0 (setq enx (entget atent))))) (prompt "\nSelected object is not an Attribute.") ) ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 enx))))))) (prompt "\nSelected Attribute is on a locked layer.") ) (if atent (setq atent_list (entget atent)) (setq atent_list (subst (cons 41 0) (assoc 42 atent_list) atent_list )) (entmod atent_list) )) (if sUndo (vlax-invoke (vla-get-ActiveDocument (vlax-get-acad-object)) 'EndUndoMark)) )(princ) )(vl-load-com)(princ) by researching past codes from pros like Lee Mac and Grrr, i was able to create this lisp all on my own. At work we have a program that inserts Blocks with a multiline attributes with information set in them and each value is it's own line of text. Unfortunately, sometimes, by that i mean most of the time, if a space is inside the information, it'll "word wrap" and create a new line. It is very annoying having to double click the attribute, then "..." and then change the width of sometimes over 100 attributes. Out of frustration, this Code was born. I welcome everyone to criticize this code as much as they can, i like learning how others would have written it. what i added that wasn't needed, what i needed that wasn't added, what would have been an easier approach. don't hold nothing back! If i didn't give credit to some of the original creators of the code that inspired me, i apologize. you guys deserve all the credit.

Does anyone know if it's possible to manipulate the vertical line spacing of multiline attributes within a block?

Hello, Someone can help with the following: In a job I have different multiline styles. Using a routine will it be possible to toggle current style just picking on one of these multilines? Thanks Aalmeidah

Dear All, I need to draw a mline in a drawing and I' m going to close it as rectangle box. I command mode it is so easy but in VBA programming mode I have no idea. Is there any chance to do the matter Thx Manouchehr

I have existing multilines with linetypes set to byLayer, yet when the linetype on the layer changes, the Multiline linetype does not. Is there any way to get the linetype to change with the layer?

Hello everyone, this is my first post here (though I have been reading these Forums for quite a while). When you create a new multiline style (or modify an existing one) you can set a "Description" text. That text can be seen when you do the following: "MLINE" "STyle" "?" What I wish to do is retrieve that information through LISP. I couldn't find it when applyling entget-car-entsel or vlax-dump-object to the multiline entity. I don't know if this is relevant, but I shall explain why I need that description. We use multilines here to draw structural elements. The name of the MLSTYLE is the name of the steel profile, for example W150X29.5. The second number (29.5) is the linear mass of the piece (kg/m). What I need to do is multiply the MLINE length and the linear mass to obtain the final mass of the element. The problem is that I can't create a multiline style named "W150X29.5" because of the . character, which is forbidden. So I thought I'd place the linear weight information on the MLSTYLE description to later retrieve it give it proper use. Even if you gentlemen can find me a solution that does not involve retrieving MLSTYLE Description I'd still wish to find out how to do that. Thank you all for your time. Felipe

Hello, I've made one very useful tool. It's called MLINE SPLIT and you guessed what it does. However it doesn't work on first and second vertices (1 and 2 vertex), and that is real mystery for me. Why are these vertices so different than all the other vertices. Below is my VBA code: Public Sub MLineSplit() On Error GoTo eh Dim ent As AcadEntity Dim p1 As Variant Dim p2 As Variant Dim x As Double Dim y As Double Dim atst As Double Dim min_atst As Double Dim taskas As Double Dim atst_nustatytas As Boolean Dim dblVertices() As Double Dim dblVerticesCnt As Double Dim dblVertices2() As Double Dim dblVerticesCnt2 As Double Dim sset As AcadSelectionSet Dim perdavimui As Variant Dim obj As AcadMLine Dim obj2 As AcadMLine Dim varpnt As Variant Dim krd(2) As Double Dim aa As Integer Dim objEnt As AcadMLine Dim objEnt2 As AcadMLine ThisDrawing.Utility.GetEntity ent, 1, "Select MLINE: " p2 = ThisDrawing.Utility.GetPoint(, "Select the SPLIT point in MLINE: ") x = p2(0): y = p2(1) atst_nustatytas = False dblVerticesCnt = -1 dblVerticesCnt2 = -1 'randam artimiausia If TypeOf ent Is AcadMLine Then 'AcadBlockRef isrinkimas Set obj = ent 'ThisDrawing.SetVariable "CMLSTYLE", obj.StyleName For aa = 0 To UBound(obj.Coordinates) Step 3 'MsgBox Str(obj.Coordinates(aa)) & "," & Str(obj.Coordinates(aa + 1)) & "," & Str(obj.Coordinates(aa + 2)) atst = DistanceBetween(obj.Coordinates(aa), obj.Coordinates(aa + 1), x, y) If (atst_nustatytas = False) Then min_atst = atst atst_nustatytas = True End If If atst min_atst = atst taskas = aa End If Next aa Else MsgBox "Must select MLINE!" Exit Sub End If Set perdavimui = obj.Copy Set obj2 = perdavimui 'Exit Sub For aa = 0 To UBound(obj.Coordinates) Step 3 'MsgBox obj.Coordinates(aa) 'MsgBox obj.Coordinates(aa + 1) 'MsgBox obj.Coordinates(aa + 2) If aa >= taskas Then dblVerticesCnt = dblVerticesCnt + 3 ReDim Preserve dblVertices(dblVerticesCnt) dblVertices(dblVerticesCnt - 2) = obj.Coordinates(aa) dblVertices(dblVerticesCnt - 1) = obj.Coordinates(aa + 1) dblVertices(dblVerticesCnt) = obj.Coordinates(aa + 2) End If If aa dblVerticesCnt2 = dblVerticesCnt2 + 3 ReDim Preserve dblVertices2(dblVerticesCnt2) dblVertices2(dblVerticesCnt2 - 2) = obj2.Coordinates(aa) dblVertices2(dblVerticesCnt2 - 1) = obj2.Coordinates(aa + 1) dblVertices2(dblVerticesCnt2) = obj2.Coordinates(aa + 2) End If Next aa If ThisDrawing.ActiveSpace = acModelSpace Then If dblVerticesCnt >= 5 Then obj.Coordinates = dblVertices If dblVerticesCnt2 >= 5 Then obj2.Coordinates = dblVertices2 Else If dblVerticesCnt >= 5 Then obj.Coordinates = dblVertices If dblVerticesCnt2 >= 5 Then obj2.Coordinates = dblVertices2 End If obj.Update obj2.Update Exit Sub eh: MsgBox "Error number: " & str(Err.Number) & " . Description: " & Err.Description End Sub