Leaderboard

You can use my Incremental Numbering Suite, specifying an increment of 9 or 10.

1.ssget 2.populate selection set as list 3.vl-sort function to sort increasing X-coordinates 4.loop using mapcar/ repeat / foreach / while to do it (serial number as TEXT) (defun c:test ( / i f s l a b ) (and (setq i -1 f '((x e)(assoc x (entget e))) s (ssget '((0 . "INSERT")))) (setq l (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) ''((a b)(< (cadr (f 10 a))(cadr (f 10 b) )))) a (cdr (f 10 (car l))) ) (foreach x l (grdraw a (setq b (cdr (f 10 x))) 1)(setq a b) ;;; Try put code your serial number here ;;; (princ (strcat "\nPut your Serial number : " (itoa (setq i (1+ i))))) ) ) (princ) ) To put serial number TEXT, try use entmake function, cons with dxf index 0, 1, 10, 40. strcat for prefix, example 'i' is incremental value, i.e: ( cons 1 (strcat "GF-S-" (itoa i)) )

1st question to devitg why dotted pair ? (nth 1 (nth x)) & (nth 2 (nth x)) 2nd question is to temy do the dims exist or do they need to be added to the circle ?

First step by a new way (defun textOverrideDim (dim txt / ) (entmod (subst (cons 1 txt) (assoc 1 (entget dim)) (entget dim)) ) ) ;; test of textOverrideDim (defun c:test (/) (textOverrideDim (car (entsel)) "Hello") ) ;;;;;;;;;;;;; (defun searchInLookupTable (rad / a b c res) (foreach a lookuptable (setq b (atoi (rtos rad 2 0))) (setq c (nth 0 a)) (if (= c b) (setq res (nth 1 a)) ) ) res ) ;; Convert Dimensions Lookuptable (defun c:cdl ( / circle dim rad diameter code) (while T (setq code nil) ;; select circle (setq circle (car (entsel "\nSelect Circle: "))) ;; select Dim (setq dim (car (entsel "\nSelect Dim: "))) ;; read diameter (setq rad (cdr (assoc 40 (entget circle)))) ;; lookup 2X radius, code returned (setq code (searchInLookupTable (* rad 2.0))) (if code (textOverrideDim dim code) ) ) )

First , make the list as doted pair , so you can get the value by ASSOC . (setq doted-pair-table (list (cons 75 "5K-10A") (cons 80 "5K-15A") (cons 85 "5K-20A") (cons 95 "5K-25A") (cons 115 "5K-32A") (cons 120 "5K-40A") (cons 130 "5K-50A") (cons 155 "5K-65A") (cons 180 "5K-80A") (cons 190 "5K-90A") (cons 200 "5K-100A") (cons 235 "5K-125A") (cons 265 "5K-150A") (cons 300 "5K-175A") (cons 345 "5K-225A") (cons 385 "5K-250A") (cons 430 "5K-300A") (cons 480 "5K-350A") ) ) (setq text (cdr (assoc 235 doted-pair-table))) ;; it give "5K-125A"

Happy with this? What to do: - You draw the blue diameter dimension objects (they will display the diameter) - command CDL (for Convert Dimensions Lookuptable) - select a circle - select a diameter dimension objects -> the routine will read the radius of the circle, lookup the code in the table, if it finds it it will put that code as the text override of the dim I put it in a while loop. Press escape to exit Check the data of the lookuptable and correct/extend if needed. (setq lookuptable (list (list 75 "5K-10A") (list 80 "5K-15A") (list 85 "5K-20A") (list 95 "5K-25A") (list 115 "5K-32A") (list 120 "5K-40A") (list 130 "5K-50A") (list 155 "5K-65A") (list 180 "5K-80A") (list 190 "5K-90A") (list 200 "5K-100A") (list 235 "5K-125A") (list 265 "5K-150A") (list 300 "5K-175A") (list 345 "5K-225A") (list 385 "5K-250A") (list 430 "5K-300A") (list 480 "5K-350A") ) ) (defun textOverrideDim (dim txt / ) (entmod (subst (cons 1 txt) (assoc 1 (entget dim)) (entget dim)) ) ) ;; test of textOverrideDim (defun c:test (/) (textOverrideDim (car (entsel)) "Hello") ) ;;;;;;;;;;;;; (defun searchInLookupTable (rad / a b c res) (foreach a lookuptable (setq b (atoi (rtos rad 2 0))) (setq c (nth 0 a)) (if (= c b) (setq res (nth 1 a)) ) ) res ) ;; Convert Dimensions Lookuptable (defun c:cdl ( / circle dim rad diameter code) (while T (setq code nil) ;; select circle (setq circle (car (entsel "\nSelect Circle: "))) ;; select Dim (setq dim (car (entsel "\nSelect Dim: "))) ;; read diameter (setq rad (cdr (assoc 40 (entget circle)))) ;; lookup 2X radius, code returned (setq code (searchInLookupTable (* rad 2.0))) (if code (textOverrideDim dim code) ) ) )

These may help: AutoCAD shortcuts & hotkey guide Function Key Reference 10 AutoCAD temporary override keys I've seen too much code written for tasks that could already be done using a simple toggle.

Hi AMIR just to give you some extra gift.... for Xmas here a simply code to be written inside previously excel file produced, in order to have zoom on selected coordinates object. I mean: - Inside excel file produced with your text info, you have also the object coordinates..... how to do the opposite if you have a big drawing, so how to find excel selected text inside wide drawing, may you have hundred text... how to find quickly inside the drawing. - If you open the excel file, select first x coordinates cell and run the below code: Sub Opendwg() Dim acadApp As Object Dim acadDoc As Object Dim MyCenter(0 To 2) As Double Dim MyMag As Double 'Check if AutoCAD application is open. If is not opened create a new instance and make it visible. Set acadApp = GetObject(, "AutoCAD.Application") Set acadDoc = acadApp.ActiveDocument ' If acadApp Is Nothing Then ' Set acadApp = CreateObject("AutoCAD.Application") ' acadApp.Visible = True ' End If CellsX = ActiveCell.Value YCol = ActiveCell.Column + 1 CellsY = Cells(ActiveCell.Row, YCol).Value ZCol = ActiveCell.Column + 2 CellsZ = Cells(ActiveCell.Row, ZCol).Value MyCenter(0) = CellsX MyCenter(1) = CellsY MyCenter(2) = CellsZ MyMag = 5 acadDoc.Application.ZoomCenter MyCenter, MyMag End Sub The above code center the drawing zoom on coordinates indicated in the excel file (columns A to C, equal to X,Y,Z value). First step open the CAD file as Object inside EXCEL, follow with hyphens ' commented, if not open create a new empty drawing, but this will be not useful for your project (just for your info). The main zoom option it's made with ZoomCenter function, where you have to pass the coordinates as double format and array sized 0 to 2 (MyCenter (0 to 2) As Double), and a magnification value settled to 5 but you can change (MyMag As Double). Be careful, all code I sent you there are no cross check, so if you select a different cell from those inside the file, of course the routine give an error, or if you do not select a text inside Autocad Drawing the same. Bye PorvaDrawing1.xlsx

Take a look at the clip command

Have a look at image for pick sequence. Ok lets walk before we run make it work for 1 lane 1st then consider dual lanes.

Sorry to insist with code, but today I have some time to spent with joking with visual basic, and cad. Here attached code for export data directly in an Excel workbook. You have to start the VBA Code with Excel program opened, and in any case will be created an addition cartel. Attached drawing consist of 4 text aligned on y axis I used for test, if you are not able to open I'll save with oldest Cad release. if you have a special own excel form to fill, VBA module could be fixed in order to write data in correct columns and/or rows. I guess now you have a lot of work to do.... Bye Module4.bas TestDrawing1.dwg

Hi Amir, here your code selection, reorder and move text on drawing and write on text file Sub PeterXX() Dim MyObject As AcadEntity Dim MyCoord() As Double Dim MyNewCoords() As Double Dim A As Integer Dim MyX() As Double Dim MyY() As Double Dim MyZ() As Double Dim ss As AcadSelectionSet Dim FilterType(0) As Integer Dim FilterData(0) As Variant FilterType(0) = 0 FilterData(0) = "TEXT,MTEXT" Set ss = ThisDrawing.SelectionSets.Add("MySsS") ss.SelectOnScreen FilterType, FilterData ReDim MyX(ss.Count - 1) ReDim MyY(ss.Count - 1) ReDim MyZ(ss.Count - 1) A = 0 For Each MyObject In ss MyCoord = MyObject.InsertionPoint MyX(A) = MyCoord(0) MyY(A) = MyCoord(1) MyZ(A) = MyCoord(2) A = A + 1 Next iFirstRow = LBound(MyY) iLastRow = UBound(MyY) For i = iFirstRow To iLastRow - 1 For j = i + 1 To iLastRow If MyY(i) > MyY(j) Then varTemp = MyY(j) MyY(j) = MyY(i) MyY(i) = varTemp End If Next j Next i ReDim MyNewCoords(0 To 2) A = 0 Open "C:\Users\Utente\Documents\TESTFILE.TXT" For Output As #1 For Each MyObject In ss MyNewCoords(0) = MyX(A) MyNewCoords(1) = MyY(A) MyNewCoords(2) = MyZ(A) ss.Item(A).InsertionPoint = MyNewCoords ThisDrawing.ModelSpace.AddText ss.Item(A).TextString, MyNewCoords, 5 Print #1, "VALUE " & A & " = " & ss.Item(A).TextString A = A + 1 Next ' Close #1 ss.Delete End Sub Please note: same text previously selected will be added in the same position of new order and in the same time object selected will be moved if not required "play" with below code ss.Item(A).InsertionPoint = MyNewCoords ThisDrawing.ModelSpace.AddText ss.Item(A).TextString, MyNewCoords, 5 See file attached Module3.basBye