Leaderboard

I guess it has something to do with how they build the list. txt file point 1 100.235 200.374 56.356 read-line converts it to one string "point 1 100.235 200.374 56.356" (read (strcat "(" .... ")" turns it into a list (point 1 100.235 200.374 56.356) = list of 5 items because of space (car POINT_LINE) = point (caddr POINT_LINE) = 100.235 ; should be 200.374 (cadr POINT_LINE) = 1 ;should be 100.235 (last POINT_LINE) = 56.356 ;correct I guess you could pull the z y and x in that order using (last) and removing them from the list then anything left convert to point_name? Agree

This ZoomObject.lsp function by gile worked for me using zob command on your drawing. I added two more Zoom functions zs & zt to the bottom of that lisp at https://forums.augi.com/showthread.php?175038-Twisted-View-Zoom-Object-or-Extents&p=1346976&viewfull=1#post1346976

@Tharwat English is not my native language, go to school as a nurse, indeed know little about AutoCad and Lisp but am possessed by AutoCad and Lisp. Can you forgive me because I took it as a compliment to you? But what's the meaning of understand for you? I give example what I need but you give me very beautiful code that does the same as the code of expert Mac Lee... Those codes are sophisticated but I'm not one step further because that was not what I asked. Of course I'm grateful for your time/code and can certainly learn a lot from it. I'm here to learn from you, not to be told I don't understand something. Just explain what people don't understand.

Here is my attempt and please don't run the program on formatted Mtext otherwise you would get weird result. (defun c:test (/ sel ent str old new ltr obj get ins pt1 pt2 dis ent cpy tmp grr len lst) ;;------------------------------------------------------------;; ;; Author: Tharwat Al Choufi - Date: 09.Jun.2022 ;; ;; website: https://autolispprograms.wordpress.com ;; ;;------------------------------------------------------------;; (and (princ "\nPick on text ends with number : ") (setq sel (ssget "_+.:S:E:L" '((0 . "*TEXT") (1 . "*#")))) (setq ent (ssname sel 0) str (cdr (assoc 1 (entget ent))) old "" ) (while (not (numberp (read (setq ltr (substr str 1 1))))) (setq old (strcat old ltr) str (substr str 2) ) ) (setq str (read str) new str obj (vlax-ename->vla-object ent) ) (setq pt1 (getpoint "\nSpecify base point :")) (setq pt2 (getpoint "\nNew position :" pt1)) (setq dis (distance pt1 pt2)) (princ "\nMove your cursor far from text to copy text with increments < right click to exit > :") (while (eq (car (setq grr (grread t 14 0))) 5) (redraw) (and lst (progn (mapcar 'entdel lst) (setq lst nil) t)) (and (> (setq tmp 0.0 str new len (distance pt1 (cadr grr)) ) dis ) (repeat (fix (/ len dis)) (vlax-invoke (setq cpy (vla-copy obj)) 'Move pt1 (polar pt1 (angle pt1 pt2) (setq tmp (+ tmp dis))) ) (setq ent (vlax-vla-object->ename cpy) get (entget ent) get (entmod (subst (cons 1 (strcat old (vl-princ-to-string (setq str (1+ str))) ) ) (assoc 1 get) get ) ) lst (cons ent lst) ) ) ) ) ) (princ) ) (vl-load-com)

Maybe ? + all the ground work is done. I can understand your stance on not modifying others code but 1 its on the internet and 2 its almost 20 years old. added back in the two point pick (offset) @Leika recopy it from above https://ibb.co/K54jFxK

If this is what you are dong, the new texts in a regular array such as a staircase, then you might try Lee Macs Incarray and Incarrayd which I use all the time, http://lee-mac.com/incrementalarray.html However there is a solution out there to the right click too

My intension all the time is not to work on anyone's codes so I was asking about the way the OP's situation's needs.

Yeah don't know why their are using two points as well. I guess it has to do with dxf 10 or 11 code based on justification. You only have to pick one point now and fixes your other problem @Leika you can now right click to exit. ;------------------------------------------------------------------------------------------- ;by Joe Burke - modified 3/2/2003 ;increment first number found in text or mtext object ;other characters may precede number, "A-2" +2 returns "A-4" ;works with reals and integers ;options: increment copy multiple or increment existing text ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-and-increment-text/td-p/840715 (defun c:IncrementText (/ i Ent Obj OldStr Mode NewStr OldNum Lst Res Pt x xxx) (vl-load-com) ;by Michael Puckett ;retain characters contained in pattern within string (defun wcfilter (string pattern / i c result) (setq result "" i 0) (repeat (strlen string) (if (wcmatch (setq c (substr string (setq i (1+ i)) 1)) pattern ) (setq result (strcat result c)) ) ) result ) (defun PickTest () (setq Obj (car (entsel "\nSelect text to increment: "))) (while (or (not Obj) (and (/= "MTEXT" (cdr (assoc 0 (entget Obj)))) (/= "TEXT" (cdr (assoc 0 (entget Obj)))) ) ) (setq Obj (car (entsel "\nText object not selected - try again: "))) ) (if (eq (cdr (assoc 10 (entget Obj))) "0.0 0.0 0.0") (setq bpt (cdr (assoc 11 (entget Obj)))) (setq bpt (cdr (assoc 10 (entget Obj)))) ) ) (PickTest) (setq OldStr (cdr (assoc 1 (entget obj))) OldNum (read (wcfilter OldStr "[0-9 .]")) ) (if (numberp OldNum) (progn (setq NewNum (1+ OldNum) NewStr (vl-string-subst (itoa NewNum) (itoa OldNum) OldStr 0) ) ) (princ "\nNumber not found in text object ") ) (setq x (getpoint "\nBase point :")) (setq offset (mapcar '/ (mapcar '- bpt x))) (while (setq pt (mapcar '/ (mapcar '+ offset (getpoint "\nNext point: ")))) (entmake (list '(0 . "TEXT") (cons 10 pt) '(40 . 8.0) (cons 1 NewStr) ) ) (setq Newnum (1+ NewNum) NewStr (vl-string-subst (itoa NewNum) (itoa OldNum) OldStr 0) ) ) (princ) )

Thank you both very much. Tombu, it is an excellent contribution!!!!! Thanks!!!!

Ooooops..forgot to add elevations. Now works perfectly

You're missing info <PointID> <Easting> <Northing> <Elevation> AB_12 231512 3821172 <missing> so it makes a list (AB_12 231512 3821172 ) only 3 long (if (eq (length (setq POINT_LINE (read (strcat "(" POINT_LINE ")")))) 4) ;if list POINT_LINE isn't 4 long do nothing. Dang it @exceed beat me by 30 sec!

you need <elevation> value sample has 4 columns, your test.txt has 3 columns. like this AB_12 231512 3821172 0 106-14 231400 3821000 0 T4001 230099 3821112 0 Z402 232116 3821400 0 G4-12 229941 3822612 0 R101 230169 3824992 0 B6-312 230788 3820223 0

simple way like this ;;----------------------------------------------------------------------;; ;; Offset line(s) by 10 on both sides (defun C:OBLine (/ ss pt1 pt2) (setq SS (ssadd)) (while (and (setq pt1 (getpoint "\nStart point: ")) (setq pt2 (getpoint pt1 "\nEnd point: "))) (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2))) (ssadd (entlast) ss) ) (if SS (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq ent (vlax-ename->vla-object ent)) (vla-offset ent 10) (setq offsetline1 (vlax-ename->vla-object (entlast))) (vla-offset ent -10) (setq offsetline2 (vlax-ename->vla-object (entlast))) (setq offsetline1startpt (vlax-curve-GetStartPoint offsetline1)) (setq offsetline1endpt (vlax-curve-GetEndPoint offsetline1)) (setq offsetline2startpt (vlax-curve-GetStartPoint offsetline2)) (setq offsetline2endpt (vlax-curve-GetEndPoint offsetline2)) (princ "\n offset line 1 start point : ") (princ offsetline1startpt) (princ "\n offset line 1 end point : ") (princ offsetline1endpt) (princ "\n offset line 2 start point : ") (princ offsetline2startpt) (princ "\n offset line 2 end point : ") (princ offsetline2endpt) ) ) (princ) ) and way without (entlast) is below ;;----------------------------------------------------------------------;; ;; Offset line(s) by 10 on both sides (defun C:OBLine (/ ss pt1 pt2 mspace myline offsetline1 offsetline2 offsetline1startpt offsetline1endpt offsetline2startpt offsetline2endpt) (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ss (ssadd)) (while (and (setq pt1 (getpoint "\nStart point: ")) (setq pt2 (getpoint pt1 "\nEnd point: "))) (setq myline (vlax-vla-object->ename (vla-addline mspace (vlax-3d-point pt1)(vlax-3d-point pt2)))) (ssadd myline ss) ) (if SS (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq ent (vlax-ename->vla-object ent)) (setq offsetline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset ent 10))))) (setq offsetline2 (car (vlax-safearray->list (vlax-variant-value (vla-offset ent -10))))) (setq offsetline1startpt (vlax-curve-GetStartPoint offsetline1)) (setq offsetline1endpt (vlax-curve-GetEndPoint offsetline1)) (setq offsetline2startpt (vlax-curve-GetStartPoint offsetline2)) (setq offsetline2endpt (vlax-curve-GetEndPoint offsetline2)) (princ "\n offset line 1 start point : ") (princ offsetline1startpt) (princ "\n offset line 1 end point : ") (princ offsetline1endpt) (princ "\n offset line 2 start point : ") (princ offsetline2startpt) (princ "\n offset line 2 end point : ") (princ offsetline2endpt) ) ) (princ) ) I like this way This is using vl. However, if you create a line by changing entmake to entmakex, (setq myline (entmakex ~~~)) Since you can get the ename rather than the dxf list, you can write code without (entlast) in the same way. https://www.cadtutor.net/forum/topic/18257-entmake-functions/

Ask user for start and end plot number. Little help from Alan , loop , and entmake function Done. This will handle 1 - 999 or should I say 001- 999 --Edit Added a results prompt and alert if layers aren't created or you input a higher number for start then the end. TEST Starting Plot Number: 15 Final Plot Number: 160 Layers "CP015" Thru "CP160" Created (defun C:test (/ i s lay lay list) (setq i (getint "\nStarting Plot Number: ") s (getint "\nFinal Plot Number: ") x (strcat "CP" (AT:NumFix (itoa i) 3)) ) (if (< i s) (make x)) (while (< i s) (setq lay (strcat "CP" (AT:NumFix (itoa (setq i (1+ i))) 3))) (make lay) ) (if (eq i s) (prompt (strcat "\nLayers \"" x "\" Thru \"" lay "\" Created")) (alert "Something Went wrong") ) (princ) ) (defun AT:NumFix (s n) ;; Fix number string with leading zeros ;; s - Number string to fix ;; n - Number of characters for final string ;; Alan J. Thompson, 10.29.09 (if (< (strlen s) n) (AT:NumFix (strcat "0" s) n) s ) ) (defun make (lay) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 lay) '(6 . "Continous") '(62 . 0) '(70 . 0) ) ) )

; DIAL - 2022.06.09 exceed ; https://www.cadtutor.net/forum/topic/75376-to-draw-numbers-as-clock-dial/ ; ; Commad : DIAL ; ; If you specify the center point and start point of the dial, the text is created like the dial with that radius. ; It is judged whether the angle between the center point and the starting point is closer to 0, 90, 180, or 270 degrees, ; and it is taken as the reference line. ; ; - The starting text is 0. ; - Depending on the number of text input, more numbers can be entered. ; - The size of the text can be adjusted with the TEXTSIZE command. (vl-load-com) (defun c:DIAL ( / centerpt startpt textnum startangle dialsize startangle direction exceptangle angle1piece textangle mspace textheight startnum placepoint textobj answer index stringlist objlist ) (setq centerpt (getpoint "\n pick center point : ")) (setq startpt (getpoint centerpt "\n pick start point : ")) (setq textnum (getint "\n input number of texts : ")) (setq startangle (angle centerpt startpt)) (setq dialsize (distance centerpt startpt)) (defun dtr (a) (* pi (/ a 180.0))) (defun rtd (a) (/ (* a 180.0) pi)) (setq startangle (rtd startangle)) (princ "\n because your start angle is : ") (princ startangle) (cond ((and (>= startangle 0) (< startangle 45)) (setq direction "CCW") (setq exceptangle (* 2 (- startangle 0))) ) ((and (>= startangle 45) (< startangle 90)) (setq direction "CW") (setq exceptangle (* 2 (- 90 startangle))) ) ((and (>= startangle 90) (< startangle 135)) (setq direction "CCW") (setq exceptangle (* 2 (- startangle 90))) ) ((and (>= startangle 135) (< startangle 180)) (setq direction "CW") (setq exceptangle (* 2 (- 180 startangle))) ) ((and (>= startangle 180) (< startangle 225)) (setq direction "CCW") (setq exceptangle (* 2 (- startangle 180))) ) ((and (>= startangle 225) (< startangle 270)) (setq direction "CW") (setq exceptangle (* 2 (- 270 startangle))) ) ((and (>= startangle 270) (< startangle 315)) (setq direction "CCW") (setq exceptangle (* 2 (- startangle 270))) ) ((and (>= startangle 315) (< startangle 360)) (setq direction "CW") (setq exceptangle (* 2 (- 360 startangle))) ) ) (princ "\n make it : ") (princ direction) (princ "\n exception angle : ") (princ exceptangle) (setq angle1piece (/ (- 360 exceptangle) (- textnum 1))) (setq textangle startangle) (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq textheight (getvar 'textsize)) (setq startnum 0) ; change this if you want to edit the start number (setq stringlist '()) (setq objlist '()) (repeat textnum (setq placepoint (polar centerpt (dtr textangle) dialsize)) (setq textobj (vla-addtext mspace startnum (vlax-3d-point placepoint) textheight)) (vlax-put-property textobj 'alignment 10) (setq objlist (cons textobj objlist)) (setq stringlist (cons startnum stringlist)) (setq startnum (+ startnum 1)) (cond ((= direction "CW") (setq textangle (- textangle angle1piece)) ) ((= direction "CCW") (setq textangle (+ textangle angle1piece)) ) ) );end of repeat (setq answer (getstring "\n do you want reverse it? [ SpaceBar - No / Y - Yes ] : \n")) (if (= "Y" (strcase answer)) (progn (setq stringlist (reverse stringlist)) (setq index 0) (repeat textnum (vla-put-textstring (nth index objlist) (nth index stringlist)) (setq index (+ index 1)) ) ) (progn) ) (princ) );end of defun It might be a little different from what you're looking for, but for reference. It only works by specifying two points and entering the number of texts. The direction of text writing is determined by nearest of 0,90,180,270 degrees, so it can be applied to any angle. There is no limit to the number, It is also possible to create a 360 degree protractor with 2 orthogonal points and input 361

Point 1 should work, but with no file to look at, if we look at most feature survey points they have codes that can be alpha, number or alphanumeric etc even smart codes 01F*02F, TR6-3 and so on. So if doing this all the time you should look at programs that are designed to do this. 1st example of course is CIV3D, look at Stringer Survey - Land Surveying Software or https://civilsurveysolutions.com/

If your typing X & Y to hard, do you have it in a text file csv etc if so post sample. Pretty simple task even manually. Sounds like import points but with a layer twist.

Rather than setting the width of the columns to a number, you can use strlen to get the length of strings, its a bit more complicated as you need to check each column, but this can be a defun so returns you a list of max column widths, you can use a fuzz factor on the strlen to compenstate for "11111" v's "222222". But looking at table probably not a problem, say use max strlen + 4. I think I have something if I can find will post. As you have done already can get No cols and No of rows, so can work out max len. Note ignore cell 0,0 It also needs set text justification to say centre. String max (setq strmax (apply 'max (mapcar 'strlen lst)))

Because you have used array polar (setq ss (ssget '((0 . "TEXT")))) ; ccw (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (vla-put-textstring obj (rtos x 2 0)) ) ;cw (setq x -1 y (- (sslength ss) 1)) (repeat (sslength ss) (setq obj (vlax-ename->vla-object (ssname ss (setq x (1+ x))))) (vla-put-textstring obj (rtos y 2 0)) (setq y (1- Y)) )

Just to be clear. I'm not advising that you move your drawing to the origin. I just did that as a test to see if it had any effect on zooming, which it did. If your drawing is tied to a survey, you will need to leave it where it is and just deal with the fact that you won't be able to use the Zoom Object function.

1. look at my post again I bring this up. - fixed 2. fixed tho point names cant have spaces (will mess up the list) example "point 1" - no good "point-1" - good 3. appload startup suite (use add not remove just a picture i found online) 4. PTYPE 5. should be fixed now -edit will update code later ; POINTPLT is a simple AutoLSIP program that will plot a coordinate points file ; in AutoCAD. To run POINTPLT, load POINTPLT.LSP as you would any normal ; AutoLISP file (see AutoCAD Reference Manual), type "POINTPLT" and press ; [Enter]. POINTPLT will first prompt you for an input coordinate filename. ; You must enter a vaild DOS filename at this point. The input coordinate file ; must be in the following format: ; ; Point name (no spaces) (X Cord) (Y Cord) ELEVATION(z) ; ; A sample input coordinate file (SAMPLE.DAT) is included with POINTPLT. ; ; POINTPLT uses the default (current) text style and layer. However, the ; current text style must have a defined height (height must not be "0"). ; ; If you have any questions or comments concerning POINTS, I may be reached ; via THE SPECTRUM BBS þ (501) 521-5639 ; ;------------------------------------------------------------------------------- ; * ERROR Trapping * ; (defun *ERROR* () (eop) ) ;------------------------------------------------------------------------------- ; * End of program * ; (defun EOP () (setvar "CMDECHO" POINTSPLT_CE) (princ) ) ;------------------------------------------------------------------------------- ; * Main Program * (defun C:POINTPLT (/ IN_FILE POINT_LINE POINT_NO POINT) (setq POINTSPLT_CE (getvar "CMDECHO")) (setvar "CMDECHO" 0) ;Turn "Command Echo" off (prompt "\n\nP O I N T P L T v1.0 -- Copyright (c) 1992 by Kurtis J. Jones / -Mate Software\n\n") (setq IN_FILE (open (getfiled "\nEnter points filename: " (getvar 'DWGPREFIX) "txt" 16) "r")) (while (setq POINT_LINE (read-line IN_FILE)) (if (eq (length (setq POINT_LINE (read (strcat "(" POINT_LINE ")")))) 4) (progn (setq POINT_NO (vl-princ-to-string (car POINT_LINE))) (prompt (strcat "\nPlotting point no. " POINT_NO)) (setq POINT (list (cadr POINT_LINE) ;Get easting (caddr POINT_LINE) ;Get northing (last POINT_LINE) ;Get elevation ) ) (entmake (list '(0 . "POINT") (cons 10 POINT))) (entmake (list '(0 . "TEXT") (cons 10 POINT) '(40 . 1) (cons 1 POINT_NO))) ) ) ) (close IN_FILE) (prompt "\nPOINTPLT finished") (eop) )

I took a look at your drawing and I tried everything I could think of, but nothing worked. So I turned on all the layers and moved the entire drawing to X0,Y0. Then I did a Zoom Extents and a RegenAll and now Zoom Object works fine. So, it appears that the problem is due to your drawing being extremely far away from the origin.

Just posted this over at theSwamp, thought I'd share it with you fine people also. I was inspired to write a few functions that will generate entities using the minimum possible data requirements - hence all other values are taken as default. This is handy for those who want to quickly generate entities without having to look up what codes are necessary, and which are surplus to requirement. Also, it helps beginners to use the entmake function in their codes, without too much effort. These, of course, are the quickest way to generate entities in AutoCAD - quicker than VL, and much quicker than a command call. Also, they are not affected by OSnap (so no need to turn it off). Example of usage, to create a line from (0,0,0) to (1,0,0): (Line '(0 0 0) '(1 0 0)) Yes, its as easy as that. The functions will also return the entity name of the newly created entity (if successful), and so, no need to be using 'entlast'... If you have any queries as to how to use them, just ask. (defun 3DFace (p1 p2 p3 p4) (entmakex (list (cons 0 "3DFACE") (cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)))) (defun Arc (cen rad sAng eAng) (entmakex (list (cons 0 "ARC") (cons 10 cen) (cons 40 rad) (cons 50 sAng) (cons 51 eAng)))) (defun AttDef (tag prmpt def pt hgt flag) (entmakex (list (cons 0 "ATTDEF") (cons 10 pt) (cons 40 hgt) (cons 1 def) (cons 3 prmpt) (cons 2 tag) (cons 70 flag)))) (defun Circle (cen rad) (entmakex (list (cons 0 "CIRCLE") (cons 10 cen) (cons 40 rad)))) (defun Ellipse (cen maj ratio) (entmakex (list (cons 0 "ELLIPSE") (cons 100 "AcDbEntity") (cons 100 "AcDbEllipse") (cons 10 cen) (cons 11 maj) (cons 40 ratio) (cons 41 0) (cons 42 (* 2 pi))))) (defun Insert (pt Nme) (entmakex (list (cons 0 "INSERT") (cons 2 Nme) (cons 10 pt)))) (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) (defun LWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst)))) (defun M-Text (pt str) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 1 str)))) (defun Point (pt) (entmakex (list (cons 0 "POINT") (cons 10 pt)))) (defun Polyline (lst) (entmakex (list (cons 0 "POLYLINE") (cons 10 '(0 0 0)))) (mapcar (function (lambda (p) (entmake (list (cons 0 "VERTEX") (cons 10 p))))) lst) (entmakex (list (cons 0 "SEQEND")))) (defun Solid (p1 p2 p3 p4) (entmakex (list (cons 0 "SOLID") (cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)))) (defun Text (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str)))) (defun Trce (p1 p2 p3 p4) (entmakex (list (cons 0 "TRACE") (cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)))) (defun xLine (pt vec) (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 pt) (cons 11 vec)))) (defun Layer (Nme) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 Nme) (cons 70 0)))) (defun Layer (Nme Col Ltyp LWgt Plt) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 Nme) (cons 70 0) (cons 62 Col) (cons 6 Ltyp) (cons 290 Plt) (cons 370 LWgt)))) The list is a working progress of course, but this is what I have so far. Also, if the argument names aren't too clear, a reference as to what they mean can be found here. Lee