Leaderboard

Here's a quickie: (defun c:foo (/ d s) ;; RJP » 2020-10-23 (if (and (setq d (getdist "\nOffset distance: ")) (setq s (ssget ":L" '((0 . "~INSERT"))))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (vl-catch-all-apply 'vlax-invoke (list (vlax-ename->vla-object e) 'offset d)) ) ) (princ) ) (vl-load-com)

I face the same problem every time I export the data from Excel to AutoCAD which is a point exported on location X:0.00 , Y:0.00 , Z:0.00 I don't know why it exports a point in that location ?! Can someone please help me? Look to the attached picture to be more clear Thanks EXCEL_FILE.xls

Hello Everyone, please, I need a code ( lisp ) that can help me to make offset for multiple objects at the same time.

Sorry no time to make it pretty. Why can't you just enter the value in the command line ( or pick two points )?

Your answer is most likely somewhere in this thread.

@BIGAL No, I tried still have the same problem

@SLW210 Sir, I attached Excel file have the code This is the code : _______________________________________________________________________________________________________ Private Sub CommandButton1_Click() TextHeight = TextBox30.Text If IsNumeric(TextHeight) = False Or TextHeight = 0 Then TextHeight = 0.25 DeltaX = TextBox31.Text DeltaY = TextBox32.Text Dim qst Dim acadObj As Object Dim ExcelObj As Object On Error Resume Next Set acadObj = GetObject(, "AutoCAD.Application") If acadObj Is Nothing Then qst = MsgBox("AutoCAD Is Not Open. DoYou Want To Open AutoCAD With A New Drawing?", vbYesNo) If qst <> vbYes Then Exit Sub Set acadObj = CreateObject("AutoCAD.Application") Cells(2, 9) = "" Command6.Visible = True Command7.Visible = True End If If acadObj Is Nothing Then MsgBox "You Have No AutoCad Software In Your Computer." & " Sorry, You Can't Use This Programe Without AutoCad." & vbNewLine & "If You Are Sure You Have AutoCAD In Side Your Computer, Then Please Check VBA Enabeled In AutoCAD.", vbCritical, "CSV TO AUTOCAD" Exit Sub End If '**************************************************************8 If CheckBox5.Value = True Then Dim strLayerName1, strLayerName2, strLayerName3, strLayerName4 As String Dim objLayer1, objLayer2, objLayer3, objLayer4 As Object strLayerName1 = TextBox33.Text If "" = strLayerName1 Then Exit Sub ' exit if no name entered On Error Resume Next ' handle exceptions inline 'check to see if layer already exists Set objLayer1 = acadObj.ActiveDocument.Layers(strLayerName1) If objLayer1 Is Nothing Then Set objLayer1 = acadObj.ActiveDocument.Layers.Add(strLayerName1) If objLayer1 Is Nothing Then ' check if obj has been set lyt = "'" & strLayerName1 & "'" & vbNewLine Else 'MsgBox "Added Layer '" & objLayer.Name & "'" End If Else 'MsgBox "Layer already existed" End If '************************************************************ strLayerName2 = TextBox34.Text 'If "" = strLayerName2 Then Exit Sub ' exit if no name entered On Error Resume Next ' handle exceptions inline 'check to see if layer already exists Set objLayer2 = acadObj.ActiveDocument.Layers(strLayerName2) If objLayer2 Is Nothing Then Set objLayer2 = acadObj.ActiveDocument.Layers.Add(strLayerName2) If objLayer2 Is Nothing Then ' check if obj has been set lyt = lyt & "'" & strLayerName2 & "'" & vbNewLine Else 'MsgBox "Added Layer Layer '" & objLayer.Name & "'" End If Else 'MsgBox "Layer already existed" End If End If '****************************************************************** Dim basePnt(0 To 2) As Double Dim insertPnt(0 To 2) As Double Dim strLayerName5 As String Dim objLayer5 As Object Set ExcelObj = GetObject(, "Excel.Application") Set acadObj = GetObject(, "AutoCAD.Application") ExcelObj.WindowState = xlMinimized acadObj.WindowState = vbMaximizedFocus Do i = i + 1 If Range("START_1").Offset(i, 0).Value <> "x" And Range("START_1").Offset(i, 0).Value <> "X" Then '************************************************ If CheckBox7.Value = True Then objLayer5 = Empty strLayerName5 = Range("START_1").Offset(i, 4).Text If "" = strLayerName5 Then GoTo Dick ' exit if no name entered On Error Resume Next ' handle exceptions inline 'check to see if layer already exists Set objLayer5 = acadObj.ActiveDocument.Layers(strLayerName5) 'If objLayer5 Is Nothing Then Set objLayer5 = acadObj.ActiveDocument.Layers.Add(strLayerName5) If objLayer5 Is Nothing Then ' check if obj has been set lyt = "'" & strLayerName5 & "'" & vbNewLine Else 'MsgBox "Added Layer '" & objLayer.Name & "'" End If 'Else 'MsgBox "Layer already existed" 'End If End If '********************************************************* Dick: basePnt(0) = Range("START_1").Offset(i, 0).Value basePnt(1) = Range("START_1").Offset(i, 1).Value basePnt(2) = Range("START_1").Offset(i, 2).Value If TextBox33.Enabled = True Then acadObj.ActiveDocument.ActiveLayer = acadObj.ActiveDocument.Layers(strLayerName1) If CheckBox7.Value = True Then If "" <> strLayerName5 Then acadObj.ActiveDocument.ActiveLayer = acadObj.ActiveDocument.Layers(strLayerName5) Else If TextBox34.Enabled = False Then acadObj.ActiveDocument.ActiveLayer = acadObj.ActiveDocument.Layers("0") End If pointObj = Nothing Set pointObj = acadObj.ActiveDocument.ModelSpace.AddPoint(basePnt) If pointObj Is Nothing Then MsgBox ("AutoCAD Not Responding"): Exit Sub insertPnt(0) = basePnt(0) + DeltaX insertPnt(1) = basePnt(1) + DeltaY insertPnt(2) = 0 If pointObj Is Nothing Then acadObj.WindowState = vbMinimizedFocus: ExcelObj.WindowState = xlMaximized: MsgBox "Sorry, AutoCad Application Is Not Responding.", vbCritical 'Set pointText = acadObj.ActiveDocument.modelspace.AddText(Range("START_1").Offset(i, -1).Value, insertPnt, TextHeight) If TextBox34.Enabled = True Then acadObj.ActiveDocument.ActiveLayer = acadObj.ActiveDocument.Layers(strLayerName2) If CheckBox30.Value = True Then TEXT_POINT = Range("START_1").Offset(i, -1).Value & Chr(10) If CheckBox31.Value = True Then TEXT_POINT = TEXT_POINT & "X= " & basePnt(0) & Chr(10) If CheckBox32.Value = True Then TEXT_POINT = TEXT_POINT & "Y= " & basePnt(1) & Chr(10) If CheckBox33.Value = True Then TEXT_POINT = TEXT_POINT & "Z= " & basePnt(2) Set pointText = acadObj.ActiveDocument.ModelSpace.AddMText(insertPnt, 0, TEXT_POINT) pointText.Height = TextHeight TEXT_POINT = "" pointObj.Color = Range("START_1").Offset(i, 3).Value End If Loop Until Range("START_1").Offset(i, 0).Value = "" 'ExcelObj.WindowState = xlMaximized 'acadObj.WindowState = vbMinimizedFocus Dim jj jj = (i * 3) - 1 Dim dblVertices() As Double ReDim dblVertices(jj) If CheckBox34.Value = True Then 'acadObj.Activedocument.ActiveLayer = acadObj.Activedocument.Layers(strLayerName4) ' Dim COUNT, CO As Integer co = 0 For Count = 1 To i dblVertices(co) = Range("START_1").Offset(Count, 0).Value co = co + 1 dblVertices(co) = Range("START_1").Offset(Count, 1).Value co = co + 1 dblVertices(co) = Range("START_1").Offset(Count, 2).Value co = co + 1 Next Count Set objEnt = acadObj.ActiveDocument.ModelSpace.Add3DPoly(dblVertices) End If End Sub

That's also how I would interpret it - 60 deg. from vertical. I'd probably have dimensioned it at the other end as 30 deg from the 1.25 dimension leader on the centreline. But TBH that's all horrible dimensioning. There is nothing to position the boss (other than being on centre) and the 2.5 goes to the centre of a lug/hole you can't even see and have to infer from the '2x .38 THRU'. EDIT - I can see the lug/hole in hidden detail now that I'm on another device. When dimensioning anything you should think of how the person making/inspecting it will be able to measure it.

To me, the angle shows how much the pipe section is inclined from a vertical line.