Leaderboard

You could also do something like this: (cond ((= (getvar 'cvport) 1) (alert "Code does not work in paperspace! Here we come modelspace! :)") (setvar 'tilemode 1) ) )

Or maybe : ;;;|=====================================================================|;;; ;;;| Gap Line Tool |;;; ;;;|provided by James Hodson, SDC Edmonton, Company, 2009 |;;; ;;;|=====================================================================|;;; ;;; ;;; (alert "Type GL to start, click a horizontal line to gap off of a vertical, and click a vertical line to gap off of a horizontal This runs again immediately if you hit space bar after your first two lines. Happy Clicking!") (defun c:gl (/ *error* sv_vals ar LINE1 LN P1 P2 AN LINE2 P3 P4 IN BPT1 PBT2) (defun *error* (msg) (mapcar '(lambda (x y) (setvar x y)) (list 'cmdecho 'osmode 'clayer) sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) );end_*error* (setq sv_vals (mapcar 'getvar (list 'cmdecho 'osmode 'clayer))) (mapcar '(lambda (x y) (setvar x y)) (list 'cmdecho 'osmode) '(0 0)) (cond ( (not *mygap*) (setq *mygap* 0.0) (initget 6) (setq *mygap* (cond ( (getreal (strcat "\nEnter Gap Size <" (rtos *mygap* 2 3) "> : "))) (*mygap*))) ) );end_cond (while (not (setq ENT1 (car (entsel "\nSelect crossing line to break : ")))) (princ "\nNull Selection please try again: ") ) (setq LINE1 (entget ENT1)) (setq LN (cdr (assoc 8 LINE1))) (setq P1 (trans (cdr (assoc 10 LINE1)) 0 1 )) (setq P2 (trans (cdr (assoc 11 LINE1)) 0 1 )) (setq AN (angle P1 P2)) (while (not (setq ENT2 (car (entsel "\nSelect line to cross over : ")))) (princ "\nNull Selection please try again: ") ) (setq LINE2 (entget ENT2)) (setq P3 (trans (cdr (assoc 10 LINE2))0 1)) (setq P4 (trans (cdr (assoc 11 LINE2))0 1)) (setq IN (inters P1 P2 P3 P4)) (setq BPT1 (polar IN AN (/ *mygap* 2))) (setq BPT2 (polar IN (+ AN pi) (/ *mygap* 2))) (command "break" ENT1 BPT1 BPT2) (mapcar '(lambda (x y) (setvar x y)) (list 'cmdecho 'osmode 'clayer) sv_vals) (setq *error* nil) (princ) )

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret) (if ss (repeat (setq i (sslength ss)) (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret)) ) ) ) (defun KGA_String_Join (strLst delim) (if strLst (apply 'strcat (cons (car strLst) (mapcar '(lambda (a) (strcat delim a)) (cdr strLst)) ) ) "" ) ) (defun KGA_String_SplitAll (str sub ignoreCaseP / i j len lst srchStr) (if (/= 0 (setq len (strlen sub))) (progn (if ignoreCaseP (progn (setq srchStr (strcase str)) (setq sub (strcase sub)) ) (setq srchStr str) ) (setq i 0) (while (setq j (vl-string-search sub srchStr i)) (setq lst (cons (substr str (1+ i) (- j i)) lst)) (setq i (+ j len)) ) (reverse (cons (substr str (1+ i)) lst)) ) ) ) (defun UpdateMtext (obj / strLst) (setq strLst (KGA_String_SplitAll (vla-get-textstring obj) "\\P" nil)) (vla-put-textstring obj (strcat "\\pxt15;" ; Tab setting. (KGA_String_Join (append (list (car strLst) (cadr strLst) ) (mapcar '(lambda (sub / lst) (strcat (last (vl-remove "NX" (KGA_String_SplitAll sub "\t" nil))) "\tNC" ) ) (cddr strLst) ) ) "\\P" ) ) ) ) (defun c:Test ( / doc ss) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-endundomark doc) (vla-startundomark doc) (if (setq ss (ssget '((0 . "MTEXT")))) (foreach obj (KGA_Conv_Pickset_To_ObjectList ss) (UpdateMtext obj) ) ) (vla-endundomark doc) (princ) )

@dlanorh you can use comma for the string pattern instead of the repetition of the same expression many times like this: *SEWER*,*SWR*" and you can add as many as you want.

you're welcome... really was a small fix. First line in your csv has a header and without having the csv file on my first attempt I didn't account for that. After seeing the file it was simply a matter of sipping the first line

Reducing the number of operations performed by the sorting function will significantly improve the performance of the program, since the data used for the sort need only be extracted from each entity once, as opposed to for each comparison - as such, I would suggest the following: (defun c:sorttextbyx ( / e i l s x ) (if (setq s (ssget '((0 . "TEXT")))) (progn (repeat (setq i (sslength s)) (setq i (1- i) e (ssname s i) l (cons e l) x (cons (cadr (assoc 10 (entget e))) x) ) ) (foreach n (vl-sort-i x '<) ;; Do something with the sorted result - (princ (strcat "\nX-Coord: " (rtos (nth n x)) "\tContent: " (cdr (assoc 1 (entget (nth n l)))))) ) ) ) (princ) )

something like this? (defun sort-x ( / ss); left -> right (if (setq ss (ssget ":L" '((0 . "TEXT")))) (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (function (lambda (a b) (< (cadr (assoc 10 (entget a)))(cadr (assoc 10 (entget b))))))))) (defun sort-y ( / ss); up -> down (if (setq ss (ssget ":L" '((0 . "TEXT")))) (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (function (lambda (a b) (> (caddr (assoc 10 (entget a)))(caddr (assoc 10 (entget b))))))))) (defun c:t1 ( / i) (setq i 0) (mapcar '(lambda (x) (princ (strcat "\nX" (itoa (setq i (1+ i))) " = " (rtos (cadr (assoc 10 (entget x))) 2 2)))) (sort-x)) (princ) ) (defun c:t2 ( / i) (setq i 0) (mapcar '(lambda (x) (princ (strcat "\nY" (itoa (setq i (1+ i))) " = " (rtos (caddr (assoc 10 (entget x))) 2 2)))) (sort-y)) (princ) )

If you want to keep this in plain AutoCAD, do a little prepwork first. Create each pipe OD and ID and extrude it 1" to make a pup piece. Then, use a catalog like Weldbend to create your 90s and 45s, etc. Make blocks of each one, throw them on a Tool Palette. Utilize Dynamic UCS where you can. Place these items, and use the Grips to stretch the pipe solids, and connect the elbows as necessary. If you're going to this length though I would consider a piping package such as AutoCAD MEP. Made a quick and dirty video, hope this helps: https://www.screencast.com/t/YRBlq6BYz0W -TZ

(to me) It's a bit of problem that the entities are not drawn in WCS. I can do it for my dwg, maybe somebody can adapt it to work for yours Command MAT (for Move Arc Tangent) select the arc select the block again anywhere (this is another ToDo: extract the parent...) select the line ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))) ) (defun xLine (pt vec) (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 pt) (cons 11 vec))) ) (defun dArc (cen rad sAng eAng) (entmakex (list (cons 0 "ARC") (cons 10 cen) (cons 40 rad) (cons 50 sAng) (cons 51 eAng)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) (vl-load-com) (defun c:mat ( / arc arc2 parent l1 c1 s e r bi p1 sloped hor lst p2 p3) (setq arc (nentsel "\nSelect Arc")) ;;(setq parent (cdr (assoc 330 (entget (car arc))))) (setq parent (entsel "\nSelect Block")) (setq l1 (entsel "\nSelect Line")) ;; center/start/end/radius of the Arc inside block (edit) ;; we will copy/paste the arc outside of the block (setq c1 (cdr (assoc 10 (entget (car arc))))) (setq s (cdr (assoc 50 (entget (car arc))))) (setq e (cdr (assoc 51 (entget (car arc))))) (setq r (cdr (assoc 40 (entget (car arc))))) ;; insert point of the block (setq bi (cdr (assoc 10 (entget (car parent))))) ;; sum of both gives you the center outside the block (setq c1 (list (+ (nth 0 c1) (nth 0 bi)) (+ (nth 1 c1) (nth 1 bi)) )) ;; copy the arc (setq arc2 (dArc c1 r s e)) ;; p1: closest point on the line to the center of the arc (perpendicular) (setq p1 (vlax-curve-getClosestPointTo (car l1) c1)) ;; draw a sloped line (setq sloped (Line c1 p1)) ;; find the intersection of the arc / sloped line (setq lst (LM:intersections (vlax-ename->vla-object sloped) (vlax-ename->vla-object arc2) acextendnone)) (setq p2 (nth 0 lst)) ;; draw a horizontal XLine (setq hor (xLine p2 (list 1.0 0.0) )) ;; find the intersection of the horizontal xLine / l1 (setq lst (LM:intersections (vlax-ename->vla-object hor) (vlax-ename->vla-object (car l1)) acextendnone)) (setq p3 (nth 0 lst)) ;; move arc to p3 (vla-move (vlax-ename->vla-object (car parent)) (vlax-3d-point p2)(vlax-3d-point p3)) ;; delete temporary items Line, xLine, Arc (entdel sloped) (entdel hor) (entdel arc2) ) MAT.dwg

Wow a big question. I have spent years trying to improve my ex team (I retired recently), a lot of it is seconds here and there, like CIV3D I stopped using Toolspace to change surface styles its was like 4 picks have a toobar now 1 pick. We had some guys that were guns others How many days ! We had a 3rd party add on made a lot of the stuff of road design much easier, CIV3D can be a big overhead. A few minutes spent ticking off cross sections not needed for sheet production compared to say an hour rearranging. We just know lots of little tricks. Design is on edge of road but construction want top of kerb levels so we cheat move design up 110mm plot long sections, move back plot crossections, or I have adjust levels in bulk so add 110mm to levels a few seconds fix. Its the little things that save time, we have a bubble lisp it just draws a circle and puts alpha or numeric in it, but increases for every bubble, old way copy and edit, its as fast as you can pick a point. 10 points say 5 seconds. The surveyors were having problems with trees, two items trunk and spread so did something for them, finds them and uses a dynamic block. One of my previous roles was Civil software support so learnt lots of solutions for various problems. Any way I think before we can help you need to tell us where you are struggling, I had a team of 8 so we would bounce solutions off each other, are there other engineers or just the boss ? Is your boss comparing you to some one else ? Go talk to them find out why they are quicker what tricks do they use. My biggest was 88 sheets one dwg 12 roads multi millions. So thinking about how to organise from day one helped so no editing/copying between sheets. Again have a lisp to put a revised design on the correct sheet.

I draw individual center lines (each pipe and elbow) then sweep a circle (or region) of the pipes.

Sir Thank you so much for your routine... I edit it for my Filter and it works! Its long, i know, but its easy! i used excel and mostly concatenation and COPY>TRANSPOSE... Heres what i came up with: (defun LayFilterAdd (/ collection names) (setq names (list "")) (if (not (vl-catch-all-error-p (setq collection (vl-catch-all-apply (function (lambda () (vla-item (vla-getextensiondictionary (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) "ACAD_LAYERFILTERS"))) )))) (vlax-for item collection (setq names (cons (vla-get-name item) names)))) names (or(member "670 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL670*\" or NAME==\"*CONTOUR_EL672*\" or NAME==\"*CONTOUR_EL674*\" or NAME==\"*CONTOUR_EL676*\" or NAME==\"*CONTOUR_EL678*\" or NAME==\"*CONTOUR_EL680*\" or NAME==\"*CONTOUR_EL682*\" or NAME==\"*CONTOUR_EL684*\" or NAME==\"*CONTOUR_EL686*\" or NAME==\"*CONTOUR_EL688*\" or NAME==\"*CONTOUR_EL690*\" or NAME==\"*CONTOUR_EL692*\" or NAME==\"*CONTOUR_EL694*\" or NAME==\"*CONTOUR_EL696*\" or NAME==\"*CONTOUR_EL698*\" or NAME==\"*CONTOUR_EL700*\" or NAME==\"*CONTOUR_EL702*\" or NAME==\"*CONTOUR_EL704*\" or NAME==\"*CONTOUR_EL706*\"" "670 LEVEL" "X" nil)) (or(member "700 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL710*\" or NAME==\"*CONTOUR_EL712*\" or NAME==\"*CONTOUR_EL714*\" or NAME==\"*CONTOUR_EL716*\" or NAME==\"*CONTOUR_EL718*\" or NAME==\"*CONTOUR_EL720*\" or NAME==\"*CONTOUR_EL722*\" or NAME==\"*CONTOUR_EL724*\" or NAME==\"*CONTOUR_EL726*\" or NAME==\"*CONTOUR_EL728*\" or NAME==\"*CONTOUR_EL730*\" or NAME==\"*CONTOUR_EL732*\" or NAME==\"*CONTOUR_EL734*\" or NAME==\"*CONTOUR_EL736*\" or NAME==\"*CONTOUR_EL738*\" or NAME==\"*CONTOUR_EL740*\" or NAME==\"*CONTOUR_EL742*\" or NAME==\"*CONTOUR_EL744*\" or NAME==\"*CONTOUR_EL746*\" or NAME==\"*CONTOUR_EL748*\" or NAME==\"*CONTOUR_EL750*\" or NAME==\"*CONTOUR_EL752*\" or NAME==\"*CONTOUR_EL754*\" or NAME==\"*CONTOUR_EL756*\" or NAME==\"*CONTOUR_EL758*\" or NAME==\"*CONTOUR_EL760*\" or NAME==\"*CONTOUR_EL762*\" or NAME==\"*CONTOUR_EL764*\" or NAME==\"*CONTOUR_EL766*\" or NAME==\"*CONTOUR_EL768*\"" "700 LEVEL" "X" nil)) (or(member "750 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL770*\" or NAME==\"*CONTOUR_EL772*\" or NAME==\"*CONTOUR_EL774*\" or NAME==\"*CONTOUR_EL776*\" or NAME==\"*CONTOUR_EL778*\" or NAME==\"*CONTOUR_EL780*\" or NAME==\"*CONTOUR_EL782*\" or NAME==\"*CONTOUR_EL784*\" or NAME==\"*CONTOUR_EL786*\" or NAME==\"*CONTOUR_EL788*\" or NAME==\"*CONTOUR_EL790*\" or NAME==\"*CONTOUR_EL792*\" or NAME==\"*CONTOUR_EL794*\" or NAME==\"*CONTOUR_EL796*\" or NAME==\"*CONTOUR_EL798*\" or NAME==\"*CONTOUR_EL800*\" or NAME==\"*CONTOUR_EL802*\" or NAME==\"*CONTOUR_EL804*\" or NAME==\"*CONTOUR_EL806*\" or NAME==\"*CONTOUR_EL808*\"" "750 LEVEL" "X" nil)) (or(member "800 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL810*\" or NAME==\"*CONTOUR_EL812*\" or NAME==\"*CONTOUR_EL814*\" or NAME==\"*CONTOUR_EL816*\" or NAME==\"*CONTOUR_EL818*\" or NAME==\"*CONTOUR_EL820*\" or NAME==\"*CONTOUR_EL822*\" or NAME==\"*CONTOUR_EL824*\" or NAME==\"*CONTOUR_EL826*\" or NAME==\"*CONTOUR_EL828*\" or NAME==\"*CONTOUR_EL830*\" or NAME==\"*CONTOUR_EL832*\" or NAME==\"*CONTOUR_EL834*\" or NAME==\"*CONTOUR_EL836*\" or NAME==\"*CONTOUR_EL838*\" or NAME==\"*CONTOUR_EL840*\" or NAME==\"*CONTOUR_EL842*\" or NAME==\"*CONTOUR_EL844*\" or NAME==\"*CONTOUR_EL846*\" or NAME==\"*CONTOUR_EL848*\" or NAME==\"*CONTOUR_EL850*\" or NAME==\"*CONTOUR_EL852*\" or NAME==\"*CONTOUR_EL854*\" or NAME==\"*CONTOUR_EL856*\" or NAME==\"*CONTOUR_EL858*\" or NAME==\"*CONTOUR_EL860*\" or NAME==\"*CONTOUR_EL862*\" or NAME==\"*CONTOUR_EL864*\" or NAME==\"*CONTOUR_EL866*\" or NAME==\"*CONTOUR_EL868*\"" "800 LEVEL" "X" nil)) (or(member "850 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL870*\" or NAME==\"*CONTOUR_EL872*\" or NAME==\"*CONTOUR_EL874*\" or NAME==\"*CONTOUR_EL876*\" or NAME==\"*CONTOUR_EL878*\" or NAME==\"*CONTOUR_EL880*\" or NAME==\"*CONTOUR_EL882*\" or NAME==\"*CONTOUR_EL884*\" or NAME==\"*CONTOUR_EL886*\" or NAME==\"*CONTOUR_EL888*\" or NAME==\"*CONTOUR_EL890*\" or NAME==\"*CONTOUR_EL892*\" or NAME==\"*CONTOUR_EL894*\" or NAME==\"*CONTOUR_EL896*\" or NAME==\"*CONTOUR_EL898*\" or NAME==\"*CONTOUR_EL900*\" or NAME==\"*CONTOUR_EL902*\" or NAME==\"*CONTOUR_EL904*\" or NAME==\"*CONTOUR_EL906*\" or NAME==\"*CONTOUR_EL908*\"" "850 LEVEL" "X" nil)) (or(member "900 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL910*\" or NAME==\"*CONTOUR_EL912*\" or NAME==\"*CONTOUR_EL914*\" or NAME==\"*CONTOUR_EL916*\" or NAME==\"*CONTOUR_EL918*\" or NAME==\"*CONTOUR_EL920*\" or NAME==\"*CONTOUR_EL922*\" or NAME==\"*CONTOUR_EL924*\" or NAME==\"*CONTOUR_EL926*\" or NAME==\"*CONTOUR_EL928*\" or NAME==\"*CONTOUR_EL930*\" or NAME==\"*CONTOUR_EL932*\" or NAME==\"*CONTOUR_EL934*\" or NAME==\"*CONTOUR_EL936*\" or NAME==\"*CONTOUR_EL938*\" or NAME==\"*CONTOUR_EL940*\" or NAME==\"*CONTOUR_EL942*\" or NAME==\"*CONTOUR_EL944*\" or NAME==\"*CONTOUR_EL946*\" or NAME==\"*CONTOUR_EL948*\" or NAME==\"*CONTOUR_EL950*\" or NAME==\"*CONTOUR_EL952*\" or NAME==\"*CONTOUR_EL954*\" or NAME==\"*CONTOUR_EL956*\" or NAME==\"*CONTOUR_EL958*\" or NAME==\"*CONTOUR_EL960*\"" "900 LEVEL" "X" nil)) (or(member "950 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL962*\" or NAME==\"*CONTOUR_EL964*\" or NAME==\"*CONTOUR_EL966*\" or NAME==\"*CONTOUR_EL968*\" or NAME==\"*CONTOUR_EL970*\" or NAME==\"*CONTOUR_EL972*\" or NAME==\"*CONTOUR_EL974*\" or NAME==\"*CONTOUR_EL976*\" or NAME==\"*CONTOUR_EL978*\" or NAME==\"*CONTOUR_EL980*\" or NAME==\"*CONTOUR_EL982*\" or NAME==\"*CONTOUR_EL984*\" or NAME==\"*CONTOUR_EL986*\" or NAME==\"*CONTOUR_EL988*\" or NAME==\"*CONTOUR_EL990*\" or NAME==\"*CONTOUR_EL992*\" or NAME==\"*CONTOUR_EL994*\" or NAME==\"*CONTOUR_EL996*\" or NAME==\"*CONTOUR_EL998*\" or NAME==\"*CONTOUR_EL1000*\" or NAME==\"*CONTOUR_EL1002*\" or NAME==\"*CONTOUR_EL1004*\" or NAME==\"*CONTOUR_EL1006*\" or NAME==\"*CONTOUR_EL1008*\" or NAME==\"*CONTOUR_EL1010*\" or NAME==\"*CONTOUR_EL1012*\" or NAME==\"*CONTOUR_EL1014*\" or NAME==\"*CONTOUR_EL1016*\" or NAME==\"*CONTOUR_EL1018*\"" "950 LEVEL" "X" nil)) (or(member "1000 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL1020*\" or NAME==\"*CONTOUR_EL1022*\" or NAME==\"*CONTOUR_EL1024*\" or NAME==\"*CONTOUR_EL1026*\" or NAME==\"*CONTOUR_EL1028*\" or NAME==\"*CONTOUR_EL1030*\" or NAME==\"*CONTOUR_EL1032*\" or NAME==\"*CONTOUR_EL1034*\" or NAME==\"*CONTOUR_EL1036*\" or NAME==\"*CONTOUR_EL1038*\" or NAME==\"*CONTOUR_EL1040*\" or NAME==\"*CONTOUR_EL1042*\" or NAME==\"*CONTOUR_EL1044*\" or NAME==\"*CONTOUR_EL1046*\" or NAME==\"*CONTOUR_EL1048*\" or NAME==\"*CONTOUR_EL1050*\" or NAME==\"*CONTOUR_EL1052*\" or NAME==\"*CONTOUR_EL1054*\" or NAME==\"*CONTOUR_EL1056*\" or NAME==\"*CONTOUR_EL1058*\" or NAME==\"*CONTOUR_EL1060*\" or NAME==\"*CONTOUR_EL1062*\" or NAME==\"*CONTOUR_EL1064*\" or NAME==\"*CONTOUR_EL1066*\"" "1000 LEVEL" "X" nil)) (or(member "1070 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL1070*\" or NAME==\"*CONTOUR_EL1072*\" or NAME==\"*CONTOUR_EL1074*\" or NAME==\"*CONTOUR_EL1076*\" or NAME==\"*CONTOUR_EL1078*\" or NAME==\"*CONTOUR_EL1080*\" or NAME==\"*CONTOUR_EL1082*\" or NAME==\"*CONTOUR_EL1084*\" or NAME==\"*CONTOUR_EL1086*\" or NAME==\"*CONTOUR_EL1088*\" or NAME==\"*CONTOUR_EL1090*\" or NAME==\"*CONTOUR_EL1092*\" or NAME==\"*CONTOUR_EL1094*\" or NAME==\"*CONTOUR_EL1096*\" or NAME==\"*CONTOUR_EL1098*\" or NAME==\"*CONTOUR_EL1100*\" or NAME==\"*CONTOUR_EL1102*\" or NAME==\"*CONTOUR_EL1104*\" or NAME==\"*CONTOUR_EL1106*\" or NAME==\"*CONTOUR_EL1108*\"" "1070 LEVEL" "X" nil)) (or(member "1100 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL1110*\" or NAME==\"*CONTOUR_EL1112*\" or NAME==\"*CONTOUR_EL1114*\" or NAME==\"*CONTOUR_EL1116*\" or NAME==\"*CONTOUR_EL1118*\" or NAME==\"*CONTOUR_EL1120*\" or NAME==\"*CONTOUR_EL1122*\" or NAME==\"*CONTOUR_EL1124*\" or NAME==\"*CONTOUR_EL1126*\" or NAME==\"*CONTOUR_EL1128*\" or NAME==\"*CONTOUR_EL1130*\" or NAME==\"*CONTOUR_EL1132*\" or NAME==\"*CONTOUR_EL1134*\" or NAME==\"*CONTOUR_EL1136*\" or NAME==\"*CONTOUR_EL1138*\" or NAME==\"*CONTOUR_EL1140*\" or NAME==\"*CONTOUR_EL1142*\" or NAME==\"*CONTOUR_EL1144*\" or NAME==\"*CONTOUR_EL1146*\" or NAME==\"*CONTOUR_EL1148*\" or NAME==\"*CONTOUR_EL1150*\" or NAME==\"*CONTOUR_EL1152*\" or NAME==\"*CONTOUR_EL1154*\" or NAME==\"*CONTOUR_EL1156*\" or NAME==\"*CONTOUR_EL1158*\" or NAME==\"*CONTOUR_EL1160*\" or NAME==\"*CONTOUR_EL1162*\" or NAME==\"*CONTOUR_EL1164*\" or NAME==\"*CONTOUR_EL1166*\" or NAME==\"*CONTOUR_EL1168*\"" "1100 LEVEL" "X" nil)) (or(member "1150 LEVEL" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"*CONTOUR_EL1170*\" or NAME==\"*CONTOUR_EL1172*\" or NAME==\"*CONTOUR_EL1174*\" or NAME==\"*CONTOUR_EL1176*\" or NAME==\"*CONTOUR_EL1178*\" or NAME==\"*CONTOUR_EL1180*\" or NAME==\"*CONTOUR_EL1182*\" or NAME==\"*CONTOUR_EL1184*\" or NAME==\"*CONTOUR_EL1186*\" or NAME==\"*CONTOUR_EL1188*\" or NAME==\"*CONTOUR_EL1190*\" or NAME==\"*CONTOUR_EL1192*\" or NAME==\"*CONTOUR_EL1194*\" or NAME==\"*CONTOUR_EL1196*\" or NAME==\"*CONTOUR_EL1198*\" or NAME==\"*CONTOUR_EL1200*\" or NAME==\"*CONTOUR_EL1202*\" or NAME==\"*CONTOUR_EL1204*\" or NAME==\"*CONTOUR_EL1206*\" or NAME==\"*CONTOUR_EL1208*\" or NAME==\"*CONTOUR_EL1210*\" or NAME==\"*CONTOUR_EL1212*\" or NAME==\"*CONTOUR_EL1214*\" or NAME==\"*CONTOUR_EL1216*\" or NAME==\"*CONTOUR_EL1218*\" or NAME==\"*CONTOUR_EL1220*\" or NAME==\"*CONTOUR_EL1222*\" or NAME==\"*CONTOUR_EL1224*\" or NAME==\"*CONTOUR_EL1226*\" or NAME==\"*CONTOUR_EL1228*\" or NAME==\"*CONTOUR_EL1230*\"" "1150 LEVEL" "X" nil)) (princ "Layer Filter Names » ")(princ names) (princ "\nSave, close and reopen the DWT or DWG for the Filters to be put into alphabetical order.") (princ) ); function (LayFilterAdd)

Grr (INCHES->FEETNINCHES 56.125) >> (4 FT 8.125) No its 4' 8 1/8 "

How about this one? -it is not a real one, just a pillow...

HI GUYS HOW DO YOU DO I HAVE DESIGNED THIS LISP TO HELP IN QUANTITY SURVEYING I HOPE IT IS USEFUL FOR YOU DOWNLOAD FROM HERE http://www.mediafire.com/file/594etbspmu7az0c/POLYLINES_AREAS_%2C_PERIMETER_%2C_VOLUME.rar AND THIS IS HOW CAN YOU USE IT https://www.youtube.com/watch?v=9485Qnc6rk8&feature=youtu.be THANK YOU

I agree with you Bigal , why not use blocks or layouts. But maybe user has some historical baggage I dunno... But if OP has to use polylines I would recommend putting them in a special layer so selecting them would be easier by including layer name in selection filter. anyways , another code that also sorts the polylines (untested of course since we have no sample to test it on) (defun c:t4 ( / a sp i ss to p) (setq a (vla-get-activedocument (vlax-get-acad-object)) sp (vla-get-block (vla-get-activelayout a)) i 0) (prompt "\nSelect polylines to number :") (if (setq ss (ssget ":L" '((0 . "LWPOLYLINE")))) (foreach p (vl-sort (mapcar '(lambda (x) (GetBcent x)) (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))) '(lambda (a b)(if (equal (cadr a) (cadr b) 1e-8) (< (car a) (car b)) (> (cadr a) (cadr b))))) (setq to (vla-AddText sp (itoa (setq i (1+ i))) (vlax-3d-point p) (/ (getvar 'viewsize) 50))) (vla-put-Alignment to acAlignmentRight)(vla-put-textalignmentpoint to (vlax-3d-point p))(vla-put-Alignment to acAlignmentMiddle) ) ) (vla-Regen a acActiveViewport) (princ) ) ; get boundingbox center (defun GetBcent ( %e / ll ur) (if (= (type %e) 'ENAME)(setq %e (vlax-ename->vla-object %e))) (cond ; get the centerpoint from boundingbox ((and (vlax-method-applicable-p %e 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list %e 'll 'ur))))) (mapcar (function (lambda (a b) (/ (+ a b) 2.)))(vlax-safearray->list ll)(vlax-safearray->list ur))) ; else get alignment or point ((and (vlax-method-applicable-p %e 'alignment)(= (vla-get-alignment %e) 1)) (reverse (cdr (reverse (vlax-safearray->list (vlax-variant-value (vla-get-TextAlignmentPoint %e))))))) (t (reverse (cdr (reverse (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint %e))))))) ) )

What software are you working in? There is no "Project Manager" in AutoCAD.

in my loop generator app (LG) I use : (if (and LG-ExcelApp LG-ExcelWorkBook LG-ExcelSheet) (progn (setq CurRegion (vlax-get-property LG-ExcelSheet 'UsedRange)) (setq LG-XlsMaxRow (vlax-get-property (vlax-get-property CurRegion "Rows") "Count")) (setq LG-XlsMaxCol (1+ (vlax-get-property (vlax-get-property CurRegion "Columns") "Count")))))) just subst. your names for the excel-app / workbook / sheetname

You could try this Program from @Lee Mac http://www.lee-mac.com/offsetpolysection.html Or this one http://www.lee-mac.com/doubleoffset.html

I have gone away from initget to using dcl's with radio buttons. It would make sense to highlight the button that has been previously picked so you just pick OK. This code needs that added Grrr you out there ? ; Multi button Dialog box for a single choice replacement of initget ; By Alan H Feb 2019 ; Example code ; (setq butlst '("A B or C " "A" "B" "C" ) ) ; (if (not AH:Butts)(load "Radio buttons multi.lsp")) ; (setq ans (ah:butts "V" butlst)) ; ans holds the button picked value ; (setq butlst '("Yes or No" "Yes" "No")) ; (if (not AH:Butts)(load "Radio buttons multi.lsp")) ; (setq ans (ah:butts "h" butlst)) ; ans holds the button picked value (vl-load-com) (defun AH:Butts (verhor butlst / fo fname x k ) (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w")) (write-line "AHbutts : dialog {" fo) (write-line (strcat " label =" (chr 34) (nth 0 butlst) (chr 34) " ;" )fo) (write-line " : row {" fo) (if (= (strcase verhor) "V") (write-line " : boxed_radio_column {" fo) (write-line " : boxed_radio_row {" fo) ) (setq x 1) (repeat (- (length butlst) 1) (write-line " : radio_button {" fo) (write-line (strcat "key = " (chr 34) "Rb" (rtos x 2 0) (chr 34) ";") fo) (write-line (strcat "label = " (chr 34) (nth x butlst) (chr 34) ";") fo) (write-line " }" fo) (setq x (+ x 1)) ) (write-line " }" fo) (write-line " }" fo) (write-line " ok_only;" fo) (write-line " }" fo) (close fo) (setq dcl_id (load_dialog fname)) (if (not (new_dialog "AHbutts" dcl_id) ) (exit) ) (setq x 1) (repeat (- (length butlst) 1) (setq k (strcat "Rb" (rtos x 2 0))) (action_tile k (strcat "(setq but " (rtos x 2 0) ")" "(done_dialog)")) (setq x (+ x 1)) ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete fname) ; which one picked (nth but butlst) ) ; these 2 lines are the calling code in a seperate lisp program (if (not Ah:Butts4)(load "Radio buttons multi")) (setq pos (AH:Butts4 "V" "Choose A B C D" "A" "B" "C" "D")) ; check val1 val2 val3 val4 for = "1" this is picked button.

You seek a “best fit line” for a thousand data points. Are you really looking for a best fit series of straight lines or a smooth curve (equation) that is a best fit to the points. I assume the former task. The C3D weeding feature is aimed to do this. What does it do that does not meet your requirements? If you goal is the latter task then you could import the points to Excel and do a curve fit with a polynomial, exponential or some other expression. You could then convert the smooth curve to a chordal approximation if that is your end goal.

The main function (c:ProjectTopRegionPoints) will detect the 'top' region automatically. So it should work from a script.

Nice job @rlx ! This task didn't appeared that easy as I've imagined, and on top of that a bit more requirements from the OP... I'm impressed that you prefered to use an array instead of a list structure, BTW heres mine version with some large subs that I use often - ; https://www.cadtutor.net/forum/topic/66894-export-text/ ; Schledule TEXT by Layers (defun C:test ( / SortByNth SortStringWithNumberAsNumber _substNth aL sL lyrs tmp rL n ) ; (SortByNth 0 (lambda (L) (SortStringWithNumberAsNumber L)) L) ; This one combines (SortByNth_vl-sort) and (SortByNth_SortingFoo) ; Sort Matrix Assoc List By Nth - by applying list-sorting function as a foo (defun SortByNth ( n foo L / nL snL ) (setq nL (mapcar '(lambda (x) (nth n x)) L)) (setq snL (apply (function foo) (list nL))) (vl-sort L '(lambda (a b) (< (vl-position (nth n a) snL) (vl-position (nth n b) snL)))) ) ; http://www.theswamp.org/index.php?topic=16564.msg207439#msg207439 ;; Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05")) ;; Return ("A1" "A9" "A10" "B2" "B05" "B11") (defun SortStringWithNumberAsNumber (ListOfString) (defun NormalizeNumberInString (str / ch i pat ret count buf) (setq i 0 pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") ret "" count 4 ) (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "") (if (vl-position ch pat) (progn (setq buf ch) (while (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat) (setq buf (strcat buf ch)) ) (while (< (strlen buf) count) (setq buf (strcat "0" buf))) (setq ret (strcat ret buf)) ) ) (setq ret (strcat ret ch)) ) ret ) (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i (mapcar 'NormalizeNumberInString ListOfString) '<)) ) (defun _substNth ( n itm L / i ) (setq i -1) (mapcar (function (lambda (x) (if (= n (setq i (1+ i))) itm x))) L) ) (setq aL (mapcar (function (lambda (lyr / SS i s itm aL ) (if (setq SS (ssget "X" (list '(0 . "TEXT")(cons 8 lyr)))) (repeat (setq i (sslength SS)) (setq s (cdr (assoc 1 (entget (ssname SS (setq i (1- i))))))) (or (member s sL) (setq sL (cons s sL))) (cond ( (setq itm (assoc s aL)) (setq aL (subst (cons s (1+ (cdr itm))) itm aL)) ) ( (setq aL (cons (cons s 1) aL)) ) ) ) ) (list lyr aL) ) ) ( (lambda ( / d L ) (while (setq d (tblnext "LAYER" (not d))) (setq L (cons (cdr (assoc 2 d)) L)) ) (acad_strlsort L) ) ) ) ) (setq lyrs (cons "Text/Layers" (mapcar 'car aL))) (setq tmp (cdr (mapcar '(lambda (x) "") lyrs))) (foreach s sL (setq rL (cons (cons s tmp) rL)) ) (setq rL (reverse rL)) (foreach itm aL (cond ( (not (setq tmp (cadr itm))) ) ( (setq n (vl-position (car itm) lyrs)) (foreach subitm tmp (setq rL (mapcar (function (lambda ( x / ) (cond ( (/= (car x) (car subitm)) x) ( (_substNth n (itoa (cdr subitm)) x) ) ) ) ) rL ) ) ) ) ) ) (setq rL (SortByNth 0 (lambda (L) (SortStringWithNumberAsNumber L)) rL)) (setq rL (append (list lyrs) rL (list (setq tmp (mapcar '(lambda (x) "") lyrs))) (list (cons "TOTAL:" (mapcar '(lambda (x / tmp) (if (apply 'OR (setq tmp (mapcar 'read x))) (itoa (apply '+ (vl-remove nil tmp))) "" ) ) (cdr (apply 'mapcar (cons 'list rL))) ) ) ) ) ) (WriteToExcelFile rL) (princ) ); defun C:test (defun WriteToExcelFile ( aL / xlapp xlwbs xlwbk xlshts xlsht xlrng xlcls xlrow xlcol acwbk r ) (vl-catch-all-apply (progn '(65 115 115 101 109 98 108 101 100 32 98 121 32 71 114 114 114) 'eval) '( (and aL (vl-every (function vl-consp) aL) (vl-every (function (lambda (x) (or (not x) (eq 'STR (type x))))) (apply 'append aL)) (setq xlapp (vlax-get-or-create-object "Excel.Application")) (progn (vlax-put-property xlapp 'Visible :vlax-false) t) (setq xlwbs (vlax-get-property xlapp 'WorkBooks)) (setq xlwbk (vlax-invoke-method xlwbs 'Add)) (setq xlshts (vlax-get-property xlapp 'Worksheets)) (setq xlsht (vlax-invoke-method xlshts 'Add)) (progn (vlax-put-property xlsht 'Name "NewSheet") t) (setq xlrng (vlax-get-property xlsht 'UsedRange)) (setq xlcls (vlax-get-property xlrng 'Cells)) ( (lambda ( / row col tmp lst ) (setq row 1) (mapcar (function (lambda (L) (setq col 1) (mapcar (function (lambda (x) (setq tmp (cons (list row col (vl-princ-to-string x)) tmp)) (vlax-put-property xlcls "item" row col (cond ((not x) "") ( (vl-princ-to-string x) ) ) ) (setq col (1+ col)) ) ) L ) (setq row (1+ row)) (setq lst (cons (reverse tmp) lst)) (setq tmp nil) ) ) aL ) ) ) (progn (setq xlrng (vlax-get-property xlsht 'UsedRange)) (setq xlrow (vlax-get-property xlrng 'Rows)) (setq xlcol (vlax-get-property xlrng 'Columns)) (mapcar '(lambda (prp) (vl-catch-all-apply 'vlax-put-property (list xlrng prp -4108))) '(VerticalAlignment HorizontalAlignment)) (vl-catch-all-apply 'vlax-invoke-method (list xlcol 'AutoFit)) (vlax-invoke-method xlwbk 'SaveAs (strcat (getenv "userprofile") "\\Desktop\\" (vl-filename-base (getvar 'dwgname)) ".xls") -4143 nil nil :vlax-false :vlax-false 1 2 ) t ) (progn (setq acwbk (vlax-get-property xlapp 'ActiveWorkbook)) ; duh! (setq r (vlax-get-property acwbk 'FullName)) ; duh :/ ) ) ) ) (and (eq 'VLA-OBJECT (type xlwbk)) (vl-catch-all-apply 'vlax-invoke-method (list xlwbk 'Close :vlax-true)) ) (vl-catch-all-apply 'vlax-invoke-method (list xlapp 'Quit)) (foreach o (reverse (list xlapp xlwbs xlwbk xlshts xlsht xlrng xlcls xlrow xlcol acwbk r)) (and (eq 'VLA-OBJECT (type o)) (vl-catch-all-apply 'vlax-release-object (list o))) ) (gc) (gc) r ); defun WriteToExcelFile I didn't wrote any codes in a while, so keeping a bit with the practice.

(defun c:t1 ( / lay-lst txt-sel txt-sort array fn fp r c al) (setq lay-lst (_slay) txt-sort (snort (rdup (mapcar 'car (setq txt-sel (_stxt)))))) (setq array (vlax-make-safearray vlax-vbInteger (cons 0 (1- (length txt-sort))) (cons 0 (1- (length lay-lst))))) (foreach txt txt-sel (vlax-safearray-put-element array (setq r (vl-position (car txt) txt-sort)) (setq c (vl-position (cdr txt) lay-lst)) (1+ (vlax-safearray-get-element array r c)))) (setq al (mapcar '(lambda (x)(subst "" 0 x)) (vlax-safearray->list array))) (if (and (setq fn (vl-filename-mktemp nil nil ".csv")) (setq fp (open fn "w"))) (progn (write-line (lst->csv (mapcar 'vl-princ-to-string (cons "text" lay-lst)) ",") fp) (mapcar '(lambda (x y) (write-line (lst->csv (cons x (mapcar 'vl-princ-to-string y)) ",") fp)) txt-sort al) (write-line (lst->csv (cons "totals" (mapcar '(lambda (x / s) (if (setq s (ssget "x" (list '(0 . "text") (cons 8 x))))(itoa (sslength s)) "0")) lay-lst)) ",") fp) (if fp (close fp))(gc)(princ "\nPress space to open csv report , any other key to exit") (if (equal (grread) '(2 32)) (or (shell_open (findfile fn))(command "notepad" (findfile fn)))))) (princ) )

Here's a tutorial describing various ways to achieve this - I believe you're interested in what I refer to as the "Dynamic Default".

FWIW, this may be the function that you were referring to. Nice one Ron

you make it sound like a bad thing... ; rlx 25 feb 2019 - https://www.cadtutor.net/forum/topic/66894-export-text/ (defun c:t1 ( / lay-lst txt-sel txt-sort array fn fp r c) (setq lay-lst (_slay) txt-sort (snort (rdup (mapcar 'car (setq txt-sel (_stxt)))))) (setq array (vlax-make-safearray vlax-vbInteger (cons 0 (1- (length txt-sort))) (cons 0 (1- (length lay-lst))))) (foreach txt txt-sel (vlax-safearray-put-element array (setq r (vl-position (car txt) txt-sort)) (setq c (vl-position (cdr txt) lay-lst)) (1+ (vlax-safearray-get-element array r c)))) (if (and (setq fn (vl-filename-mktemp nil nil ".csv")) (setq fp (open fn "w")) (progn (write-line (lst->csv (mapcar 'vl-princ-to-string (append (list "text") lay-lst)) ",") fp) (mapcar '(lambda (x y) (write-line (lst->csv (cons x (mapcar 'vl-princ-to-string y)) ",") fp)) txt-sort (vlax-safearray->list array)) (if fp (close fp))(gc) T)) (progn (princ "\nPress space to open csv report , any other key to exit") (if (equal (grread) '(2 32)) (or (shell_open (findfile fn))(command "notepad" (findfile fn)))))) (princ) ) ; select layers (defun _slay ( / d r )(while (setq d (tblnext "LAYER" (null d)))(setq r (cons (cdr (assoc 2 d)) r)))(snort r)) ; select texts (defun _stxt ( / e)(mapcar '(lambda (x) (cons (cdr (assoc 1 (setq e (entget x))))(cdr (assoc 8 e)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "x" '((0 . "text")))))))) ;;;remove duplicates (defun rdup (l / o)(vl-remove-if '(lambda (x) (cond ((vl-position x o) t) ((setq o (cons x o)) nil))) l)) (defun lst->csv (%l $s)(apply 'strcat (cdr (apply 'append (mapcar (function (lambda (x) (list $s x))) %l))))) (defun shell_open ( f / s r ) (if (and (setq f (findfile f)) (setq s (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))) (progn (setq r (vl-catch-all-apply 'vlax-invoke (list s 'open f)))(vlax-release-object s)(not (vl-catch-all-error-p r))))) ; Lee Mac / Gile (defun snort (l) (mapcar '(lambda (x) (nth x l)) (vl-sort-i (mapcar '(lambda (x) (vl-remove-if-not 'numberp (_SplitStr x))) l) (function (lambda (a b)(while (and a b (= (car a)(car b)))(setq a (cdr a) b (cdr b)))(if (or a b)(< (car a)(car b)) t)))))) (defun _SplitStr ( s / l p r n q ) (setq l (vl-string->list s) p (chr (car l)))(if (< 47 (car l) 58)(setq n T)) (while (setq l (cdr l))(if n (cond ((= 46 (car l))(if (and (cadr l)(setq q (strcat "0." (chr (cadr l))))(numberp (read q))) (setq r (cons (read p) r) p q l (cdr l))(setq r (cons (read p) r) p "." n nil))) ((< 47 (car l) 58)(setq p (strcat p (chr (car l)))))(t (setq r (cons (read p) r) p (chr (car l)) n nil))) (if (< 47 (car l) 58)(setq r (cons p r) p (chr (car l)) n T)(setq p (strcat p (chr (car l))))))) (if n (setq r (cons (read p) r))(setq r (cons p r)))(reverse r))

not tested ; select layers (defun _slay ( / d r ) (while (setq d (tblnext "LAYER" (null d)))(setq r (cons (cdr (assoc 2 d)) r)))(acad_strlsort r)) ; select texts (defun _stxt ( / s) (mapcar '(lambda (x) (cons (cdr (assoc 1 (setq e (entget x))))(cdr (assoc 8 e)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "x" '((0 . "text")))))))) ;;;remove duplicates (defun rdup (l / o) (vl-remove-if '(lambda (x) (cond ((vl-position x o) t) ((setq o (cons x o)) nil))) l)) (defun lst->csv (%l $s) (apply 'strcat (cdr (apply 'append (mapcar (function (lambda (x) (list $s x))) %l))))) (defun shell_open ( f / s r ) (if (and (setq f (findfile f)) (setq s (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))) (progn (setq r (vl-catch-all-apply 'vlax-invoke (list s 'open f)))(vlax-release-object s)(not (vl-catch-all-error-p r))))) (defun c:t1 ( / lay-lst txt-sel txt-sort array fn fp) (setq lay-lst (_slay) txt-sort (acad_strlsort (rdup (mapcar 'car (setq txt-sel (_stxt)))))) (setq array (vlax-make-safearray vlax-vbInteger (cons 0 (1- (length txt-sort))) (cons 0 (1- (length lay-lst))))) (foreach txt txt-sel (vlax-safearray-put-element array (setq r (vl-position (car txt) txt-sort)) (setq c (vl-position (cdr txt) lay-lst)) (1+ (vlax-safearray-get-element array r c)))) (if (and (setq fn (vl-filename-mktemp nil nil ".csv")) (setq fp (open fn "w")) (progn (write-line (lst->csv (mapcar 'vl-princ-to-string (append (list "text") lay-lst)) ",") fp) (mapcar '(lambda (x y) (write-line (lst->csv (cons x (mapcar 'vl-princ-to-string y)) ",") fp)) txt-sort (vlax-safearray->list array)) (if fp (close fp))(gc) T)) (progn (princ "\nPress space to open csv report , any other key to exit") (if (equal (grread) '(2 32)) (or (shell_open (findfile fn))(command "notepad" (findfile fn))))) ) (princ) )

The only problem with dataextraction is it gives count as 1 for every item so you have to do a macro to re-total thats what I am working on is doing the count part and could go further levels, like layer and style being counted seperately. Hence request for a dwg.

(getvar 'product)

Try this version (defun c:PText ( / *error* sv_lst sv_vals c_doc ss colour_lst t_str lyr l_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );end_*error*_defun (setq sv_lst (list 'cmdecho 'osmode) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) p_obj (vlax-ename->vla-object (car (entsel "\nSelect Prefix text : "))) p_str (vlax-get-property p_obj 'textstring) );end_setq (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (vla-startundomark c_doc) (mapcar 'setvar sv_lst '(0 0)) (prompt "\nSelect Text to Prefix : ") (setq ss (ssget '((0 . "TEXT")))) (cond (ss (vlax-for t_obj (vla-get-activeselectionset c_doc) (vlax-put-property t_obj 'textstring (strcat p_str (vlax-get-property t_obj 'textstring))) );end_forwhile ) );end_cond (mapcar 'setvar sv_lst sv_vals) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (princ) );end_defun

Hi, Just this a shot. (defun c:test (/ s x i e) (and (princ "\nPick a prefix text :") (or (setq s (ssget "_+.:S:E" '((0 . "*TEXT")))) (alert "Invalid object or nothing selected. Try again") ) (princ (strcat "\nSelect texts to add prefix [" (setq x (cdr (assoc 1 (entget (ssname s 0))))) "]. to them :" ) ) (setq i -1 s (ssget "_:L" '((0 . "*TEXT"))) ) (while (setq e (ssname s (setq i (1+ i)))) (entmod (subst (cons 1 (strcat x (cdr (assoc 1 (setq e (entget e)))))) (assoc 1 e) e ) ) ) ) (princ) )

Try this. I was unsure whether you wanted to select the text to get the prefix individually or as a selection set. It does the former, but is easily alterable to do the latter. (defun c:PText ( / *error* sv_lst sv_vals c_doc ss colour_lst t_str lyr l_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );end_*error*_defun (setq sv_lst (list 'cmdecho 'osmode) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) p_obj (vlax-ename->vla-object (car (entsel "\nSelect Prefix text : "))) p_str (vlax-get-property p_obj 'textstring) );end_setq (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (vla-startundomark c_doc) (mapcar 'setvar sv_lst '(0 0)) (while (setq t_ent (entsel "\nSelect Text to Prefix : ")) (setq t_obj (vlax-ename->vla-object (car t_ent))) (vlax-put-property t_obj 'textstring (strcat p_str (vlax-get-property t_obj 'textstring))) );end_while (mapcar 'setvar sv_lst sv_vals) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (princ) );end_defun

Try this quicky: The colour name must be words. You should alter the highlighted list for any colour names you want to add or delete (defun c:LM ( / *error* sv_lst sv_vals c_doc ss colour_lst t_str lyr l_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );end_*error*_defun (setq sv_lst (list 'cmdecho 'osmode) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) ss (ssget "_X" '((0 . "TEXT") (410 . "Model"))) colour_lst (list "* RED *" "* YELLOW *" "* GREEN *" "* CYAN *" "* BLUE *" "* MAGENTA *");<<== Alter list of colours here );end_setq (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (vla-startundomark c_doc) (mapcar 'setvar sv_lst '(0 0)) (cond ( (not (tblobjname "LAYER" "COLOURS")) (vla-add (vla-get-layers c_doc) "COLOURS"))) (cond (ss (vlax-for obj (vla-get-activeselectionset c_doc) (setq t_str (vlax-get-property obj 'textstring) lyr (strcase (vlax-get-property obj 'layer)) ) (foreach col colour_lst (cond ( (wcmatch (strcase t_str) col) (if (not (vl-position lyr l_lst)) (setq l_lst (cons lyr l_lst))))) );end_foreach );end_for (cond (l_lst (foreach lyr l_lst (command "_.-laymrg" "_N" lyr "" "_N" "COLOURS" "_Y")))) ) );end_cond (mapcar 'setvar sv_lst sv_vals) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (princ) );end_defun ;;

You are right, startup set to 0 or 1 opens a drawing1, set to 2 or 3 doesn't.

If I understand you correctly you want to identify polylines that do not have a block inserted at their start and end point. This is possible. Sadly one of your blocks has been badly designed: The insertion point of the FOC block seems totally illogical. The code below works for the other blocks. (defun KGA_Conv_Pickset_To_ObjectList (ss / i ret) (if ss (repeat (setq i (sslength ss)) (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret)) ) ) ) (defun c:Test ( / end polyLst ptLst ss ssOut sta) (if (setq ss (ssget "_X" '((0 . "INSERT,LWPOLYLINE")))) (progn (foreach obj (KGA_Conv_Pickset_To_ObjectList ss) (if (= "AcDbBlockReference" (vla-get-objectname obj)) (setq ptLst (cons (vlax-get obj 'insertionpoint) ptLst)) (setq polyLst (cons obj polyLst)) ) ) (setq ssOut (ssadd)) (foreach poly polyLst (setq sta (vlax-curve-getstartpoint poly)) (setq end (vlax-curve-getendpoint poly)) (if (not (and (vl-some '(lambda (pt) (equal pt sta 1e-8)) ptLst) (vl-some '(lambda (pt) (equal pt end 1e-8)) ptLst) ) ) (ssadd (vlax-vla-object->ename poly) ssOut) ) ) (sssetfirst nil ssOut) ) ) (princ) )

Obviously we do not need the last three circles we drew to be full circles. We'll need to trim away what isn't required in this exercise. Let's start by drawing a line 225 units long at an angle of 60 degrees. The starting point for this line will be the centerpoint of our three circles which is also the midpoint of our line that is 130 units. Start the line command, pick the centerpoint of the three circles, let go of your mouse and at the command line type in @225<60. Offset this line 25 units to the right. Use the lines designated in the image below as A and B to trim away the parts of the circles we don't need. Refer to Step 3 below. Time now to fillet some lines. Refer to Step 4 below. Fillet the intersecting lines where the letters 'a' and 'b' appear using a radius of 12. Fillet the intersecting lines where the letter 'c' appears using a radius of 38. Refer to Step 5 below. BTW...I think the 38 radius should have been 37 but we will follow the diagram provided. If you have any questions up to this point please ask. We'll stop here for now. BTW...AutoCAD gives us many different ways to achieve a task. Another member may suggest a different method to follow. Pick the method that you find the easiest to follow. My way is not necessarily the best way is all I am saying.

The above image leaves much to be desired when it comes to the dimensioning. This is how I would begin to lay out the front view.

You are really asking a lot for someone who just joined the forum. While it is totally proper to request assistance it is not a good idea to ask someone here to create the drawing for you just so you can turn around and hand it in as your own work to your instructor. I certainly would not do it. You are the student. It's your assignment. Many of us have been in the same position and we found the time to do our own drawings. The responsibility remains with you. How else are you going to learn? What have you created so far? Post an image or attach a copy of your drawing. I would start with creating all the parts of the drawing that are not shaded including any necessary reference (i.e. - centerlines). The same reference lines can be offset to locate other parts of the geometry.

I thought the ease of drawing accurately was one of the benefits of using a computer aided drafting program. If you don't want accuracy, use a pencil.

Accuracy is paramount in the world of design. Anyone who tells you otherwise should be doing something else. A defect in a measuring device used to polish the mirror for the $1.5 billion Hubbell telescope made it virtually useless. It took a second mission (and additional monies) to fix the problem.

It's been my experience that, once an error creeps in, it will get carried through everything that connects with it. An architect will use fractional units and believe that getting within 1/4" is close enough. In other words, he'd never see a difference as large as .12. After a few more near misses, each one amplifying the ones before, he'd wonder why his stuff wasn't lining up properly. As SLW210 says, there's no excuse for doing it wrong when you have the tools to do it right. The people who will use your drawings are expected to work within certain tolerances. You owe it to them, and everyone else, to do the same.

It's too easy to draw it accurate and correct to accept anything less. Like rkent, I see no reason to sketch with AutoCAD. I fix any and all drawings I get or come across with inaccurate CAD work, if I am to work in them, if someone just wants something printed, I rarely bother to check it over for such things unless it just doesn't look right. Like steven-g, I find some programs convert poorly to dwg.

I probably spend half my time making other peoples drawings accurate, I have to take off quantities from drawings supplied by others, and it is so much easier to do that if polylines are closed and not made up of overlapping objects, it's a fairly simple formula to find the length and width of a wall given perimeter and area, but only if that information is accurate. For a 160 apartment tower block, it can take me nearly a week to clean up the drawings and get things on sensible layers. It is then just a question of days to take off the quantities and create the schedules, doing all that normally is 3 to 4 weeks. And by far the best drawings, in general, come from the structural engineers, that's just a question of checking for odd errors. Drawings from Architects, that's just hoping that you can find a few that are straight. I think many of the errors are due to how "other" programs are converted to dwg.

Your listed as CIVIL so with GPS setouts, 3d machine control accuracy is becoming more important. Its so easy to do it correct using snap and ortho to say it does not matter is not the sign of a good designer.

Here's a quick update to this code since vla-get-filedependencies was removed from AutoCAD 2018. (defun c:super (/ *error* dir vars) (vl-load-com) (defun *error* (msg) ;; Reset variables (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (princ) ) (vl-mkdir (setq dir (strcat (getvar 'dwgprefix) "Superseded"))) (vl-mkdir (setq dir (strcat dir "\\" (menucmd "m=$(edtime,0,yyyy-mo-dd)")))) (if (findfile dir) (progn (setq vars (mapcar '(lambda (x) (cons x (getvar x))) '("cmdecho" "expert" "filedia"))) (mapcar '(lambda (a b) (setvar (car a) b)) vars '(0 5 0)) (command "_qsave") (command "-etransmit" "Current" "Create" (strcat dir "\\" (vl-filename-base (getvar 'dwgname))) ) (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars) ) ) (princ) )

I like great comments. I happen to enjoy learning and I enjoy this website. If I didn't enjoy it, I wouldn't do it. Sorry...

Sometimes I find myself shaking my head in disbelief. This is one of those times.

Hi,GP,Thanks for your wonderful routine. I have some improvement for you code,It fix some BUG for hatch line is too long. AlignH.lsp

By adding "@" should work, but is better to look to POLAR function instead. Also, take care to avoid interference with current auto OSNAP and conflicts with a localized version of AutoCAD/redefined commands. (command "_.LINE" "_non" point1 "_non" (polar point1 (* (/ -170.0 180.0) pi) 3860.0) "")