Leaderboard

I've improved it just a little in a fashion that now there is an option for overdrawing branches... But still they are not complete in overall lengths - for now that's all... If you can alter it to become like in your examples, then it would be perfect... I am over with this now... (defun c:pts_along_pipe_trees_by_length ( / *error* process cad doc pt bp dd ch c ell ) (vl-load-com) (defun *error* ( m ) (if (and doc (= 8 (logand 8 (getvar 'undoctl))) ) (vla-endundomark doc) ) (if doc (vla-regen doc acactiveviewport) ) (if m (prompt m) ) (princ) ) (defun process ( dd pt / proclst makepoly processlst s i el e pt d len f n par l p ) (defun proclst ( f len dd pt / par ddd ) (if (and (setq par (float (fix (vlax-curve-getparamatpoint e (trans pt 1 0))))) (setq pt (vlax-curve-getpointatparam e par)) ) (if f (progn (setq ddd (- dd (- len (vlax-curve-getdistatpoint e (trans (setq pt (trans pt 0 1)) 1 0))))) (setq processlst (cons (list ddd pt) processlst)) ) (progn (setq ddd (- dd (vlax-curve-getdistatpoint e (trans (setq pt (trans pt 0 1)) 1 0)))) (setq processlst (cons (list ddd pt) processlst)) ) ) ) ) (defun makepoly ( f e p c / ln ep i pbl par b ll lx a ex ) (setq ln (vlax-curve-getdistatparam e (setq ep (vlax-curve-getendparam e)))) (repeat (setq i (1+ (fix (+ 0.1 ep)))) (setq pbl (cons (list (vlax-curve-getpointatparam e (float (setq i (1- i)))) (if (not (vl-catch-all-error-p (setq b (vl-catch-all-apply (function vla-getbulge) (list (vlax-ename->vla-object e) i))))) b)) pbl)) ) (setq par (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e p))) (if (equal par ep 1e-6) (setq f t) ) (if f (progn (setq par (- ep par)) (setq pbl (mapcar (function (lambda ( x ) (list (car x) (if (cadr x) (- (cadr x)))))) (reverse pbl))) ) ) (if (setq b (cadr (nth (fix (+ par 1.000001)) pbl))) (progn (setq ll (if f (- (- ln (vlax-curve-getdistatparam e (float (fix par)))) (- ln (vlax-curve-getdistatparam e (float (fix (+ par 1.000001)))))) (- (vlax-curve-getdistatparam e (float (fix (+ par 1.000001)))) (vlax-curve-getdistatparam e (float (fix par)))))) (setq lx (if f (- (- ln (vlax-curve-getdistatparam e (float (fix par)))) (- ln (vlax-curve-getdistatparam e par))) (- (vlax-curve-getdistatparam e par) (vlax-curve-getdistatparam e (float (fix par)))))) (setq a (* 4.0 (atan b))) (setq b (/ (sin (/ (* (/ a ll) lx) 4.0)) (cos (/ (* (/ a ll) lx) 4.0)))) ) ) (setq pbl (reverse (member (nth (fix par) pbl) (reverse pbl)))) (setq pbl (append (subst (list (car (last pbl)) b) (last pbl) pbl) (list (list p nil)))) (setq ex (entget e)) (if (vl-some (function numberp) (mapcar (function cadr) pbl)) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pbl)) (cons 70 (* 128 (getvar 'plinegen))) (assoc 38 ex) ) (apply (function append) (mapcar (function (lambda ( x ) (list (cons 10 (trans (car x) 0 (cdr (assoc 210 ex)))) (cons 42 (if (cadr x) (cadr x) 0.0))))) pbl)) (list (assoc 210 ex) (cons 62 c) ) ) ) (progn (vl-cmdf "_.3DPOLY") (foreach pb pbl (vl-cmdf "_non" (trans (car pb) 0 1)) ) (vl-cmdf "") (entupd (cdr (assoc -1 (entmod (if (assoc 62 (setq ex (entget (entlast)))) (subst (cons 62 c) (assoc 62 ex) ex) (append ex (list (cons 62 c)))))))) ) ) ) (setq s (ssget "_C" (setq pt (osnap pt "_nea")) pt (list (cons 0 "*POLYLINE")))) (repeat (setq i (sslength s)) (if (and (not (vl-position (setq e (ssname s (setq i (1- i)))) ell)) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list e)))) ) (setq el (cons (list e pt) el)) ) ) (setq ell (append (mapcar (function car) el) ell)) (foreach ep el (setq f nil l nil) (setq e (car ep) pt (cadr ep)) (setq d (vlax-curve-getdistatpoint e (trans pt 1 0))) (setq len (vlax-curve-getdistatparam e (vlax-curve-getendparam e))) (if (equal d len 1e-6) (setq d 0.0 f t) ) (setq n (fix (setq par (vlax-curve-getparamatpoint e (trans pt 1 0))))) (if f (foreach p (reverse (repeat n (setq l (cons (trans (vlax-curve-getpointatparam e (float (1+ (fix (setq par (1- par)))))) 0 1) l)))) (proclst f len dd p) ) (foreach p (reverse (repeat (- (fix (+ 0.1 (vlax-curve-getendparam e))) n) (setq l (cons (trans (vlax-curve-getpointatparam e (float (1- (fix (setq par (1+ par)))))) 0 1) l)))) (proclst f len dd p) ) ) (cond ( (and (zerop d) (= (cdr (assoc 90 (entget e))) 2) (if f (vlax-curve-getpointatdist e (- len dd)) (vlax-curve-getpointatdist e dd) ) ) (if f (progn (entmake (list (cons 0 "POINT") (cons 10 (setq p (vlax-curve-getpointatdist e (- len dd)))))) (if (= ch "Yes") (makepoly f e p c)) ) (progn (entmake (list (cons 0 "POINT") (cons 10 (setq p (vlax-curve-getpointatdist e dd))))) (if (= ch "Yes") (makepoly f e p c)) ) ) ) ( (<= 0.0 (+ d dd) len) (if f (progn (entmake (list (cons 0 "POINT") (cons 10 (setq p (vlax-curve-getpointatdist e (- len (+ d dd))))))) (if (= ch "Yes") (makepoly f e p c)) ) (progn (entmake (list (cons 0 "POINT") (cons 10 (setq p (vlax-curve-getpointatdist e (+ d dd)))))) (if (= ch "Yes") (makepoly f e p c)) ) ) ) ) ) (foreach lst processlst (process (car lst) (cadr lst)) ) ) (if (and (setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object)))) (= 8 (logand 8 (getvar 'undoctl))) ) (vla-endundomark doc) ) (if doc (vla-startundomark doc) ) (if (and (setq pt (getpoint "\nPick or specify main base point : ")) (setq bp pt) (not (initget 6)) (setq dd (cond ( (not (setq dd (getdist pt "\nPick or specify length from base point for spread around <1.0> : "))) 1.0 ) ( t dd ))) (not (initget "Yes No")) (setq ch (cond ( (not (setq ch (getkword "\nDo you want to overmake new polylines up to resulting points [Yes / No] <Yes> : "))) "Yes" ) ( t ch ))) (if (= ch "Yes") (progn (initget 6) (setq c (cond ( (not (setq c (getint "\nSpecify color for new polylines <3> : "))) 3 ) ( t c ))) ) t ) ) (progn (vla-zoomextents (vlax-get-acad-object)) (process dd pt) ) ) (princ) ) Regards, M.R.

; ; (load "Selsort") ; (selsort 2) ; ... select object ... ; ; Verify: ; command -> Delete ; (nth 0 tlst) -> delete text "1" ; ; command -> Delete ; (nth 1 tlst) -> delete text "4" ; ; ... ; command -> Delete ; (nth 8 tlst) -> delete text "9" ; ; If TIPO > 4 TLST is reverse. ; ; ; 1 2 3 ; 4 5 6 ; 7 8 9 (defun SelSort (tipo / flag) (setq SS (ssget)) (setq tlst ; Crea una lista contenente le coord. x e y + il set di selezione (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) ) ) ;#2 & 3 ; (if (> tipo 4) ; se Tipo > 4 lo riporta ai primi 4 ma mette un Flag (setq tipo (- tipo 4) flag T) ) ; (if (= tipo 1) ; Sx-Dx & Up-Down -> 1-2-3-4-5-6-7-8-9 (setq tlst (mapcar 'cadr ;dopo aver ordinato il punto della striscia e lasciare solo il nome dell'entita' (vl-sort tlst ;#4 '(lambda (a b) (if (equal (cadr (car a)) (cadr (car b)) 1e-6) ;se y sono uguali (< (caar a) (caar b)) ;Se true: ordina prima a sinistra (> (cadr (car a)) (cadr (car b))) ;Se false: ordina prima il piu' alto ) ) ) ) ) ) ; (if (= tipo 2) ; Up-Down & Sx-Dx -> 1-4-7-2-5-8-3-6-9 (setq tlst (mapcar 'cadr ;dopo aver ordinato il punto della striscia e lasciare solo il nome dell'entita' (vl-sort tlst ;#4 '(lambda (a b) (if (equal (car (car a)) (car (car b)) 1e-6) ;se x sono uguali (> (cadr (car a)) (cadr (car b))) ;Se true: ordina prima il piu' alto (< (caar a) (caar b)) ;Se false: ordina prima a sinistra ) ) ) ) ) ) ; (if (= tipo 3) ; Dx-Sx & Up-Down -> 3-2-1-6-5-4-9-8-7 (setq tlst (mapcar 'cadr ;dopo aver ordinato il punto della striscia e lasciare solo il nome dell'entita' (vl-sort tlst ;#4 '(lambda (a b) (if (equal (cadr (car a)) (cadr (car b)) 1e-6) ;se y sono uguali (> (caar a) (caar b)) ;Se true: ordina prima a Destra (> (cadr (car a)) (cadr (car b))) ;Se false: ordina prima il piu' alto ) ) ) ) ) ) ; (if (= tipo 4) ; Up-Down & Sx-Dx -> 3-6-9-2-5-8-1-4-7 (setq tlst (mapcar 'cadr ;dopo aver ordinato il punto della striscia e lasciare solo il nome dell'entita' (vl-sort tlst ;#4 '(lambda (a b) (if (equal (car (car a)) (car (car b)) 1e-6) ;se x sono uguali (> (cadr (car a)) (cadr (car b))) ;Se true: ordina prima il piu' alto (> (caar a) (caar b)) ;Se false: ordina prima a Destra ) ) ) ) ) ) ; (if flag ; se Flag -> True Inverte la lista (setq tlst (reverse tlst)) ) ; ) I expanded the code of MHUPP... this is the result! thank you very much!

What is a good way to ensure that a border and title block are perfectly centered on the page in paper space. Someone once showed me how to do it with a window but I can't seem to remember the method. I'm using a 36x24in paper size with a .5 margin all the way around. The border will sit on this margin. I can eyeball it pretty close but I know this is not the right way. Maybe someone can point me the right direction.

It checks to see if your in paperspace for the filter. if you are it limits the selection to that tab. (SS1) The first selection is stored. You can select as many different entity's you want. (SS2) The second selection is also stored (SS3) Then it uses the first selection in select similar command. (this selects all similar items in model space or the current tab) it then checks to see if any entity's are in (SS3) and (SS2) if they are adds them to a new set called add. commented out it would then highlight those entity's (added code) then runs change prop command and updates add selection set.

If you change (strcat "E" (rtos e 2 0) ) to (strcat (rtos e 2 0) "E" ) and the same with N that will change the prefix / suffix order

or you can just switch how it sorts. 123 456 789 if statment for y sorts by row if statment for x sorts by column switch the > < signs to get the order you want ;sorts 321654987 (if (equal (cadr (car a)) (cadr (car b)) 2) ;if y are equal within 2 (> (caar a) (caar b)) (< (cadr (car a)) (cadr (car b))) ) ;sorts 963852741 (if (equal (caar a) (caar b) 2) ;if x are equal within 2 (< (cadr (car a)) (cadr (car b))) (> (caar a) (caar b)) ) ;sorts 147258369 (if (equal (caar a) (caar b) 2) (> (cadr (car a)) (cadr (car b))) (< (caar a) (caar b)) )

We later found that Autodesk had an "incentive" program ($$$.$$) if you turned someone in for illegal copies...

Many, many years ago I worked at a firm that had "multiple seats" installed but only owned 2 copies. The local dealer turned us in and we got a registered letter from a lawyer instructing us to purchase 4 more copies in the next 30 days or be subject to "blah..blah...blah.." The company bought them.. That was before the internet... I'd take it seriously.

Ok to me you have missed a step and gone onto step2, the 1st step looking at your dwg is place the blocks so pick end, pick along, enter distance and offset, block is placed. repeat as required so get 4 blocks as in dwg. Then do offset yellow line pick end block, pick next, exit and repeat for 2nd or more offset lines. The only issue I see is the end electrical panel may have to do that manually trimming lines. So yes you want step1 then step 2 ?

You could try: *CT1, 12" panel 90,0,0,0,12 90,10,0,0,12 * A blank line is essential at the end of a pattern definition, but I have found that AutoCAD tolerates a * in the last line, and it serves as a visual marker

Build a selection set with ssget use a point of some type that all entity's have. (usually #10) build a list with the entity name and point. process the list using the point after sorting process entity's (if (setq SS (ssget "_:L")) ;#1 (progn (setq tlst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))))) ;#2 & 3 (setq tlst (mapcar 'cadr ;after sort strip point and only leave entity name (vl-sort tlst ;#4 '(lambda (a b) (if (equal (cadr (car a)) (cadr (car b)) 1e-6) ;if y are equal (< (caar a) (caar b)) ;true sort left most first (> (cadr (car a)) (cadr (car b))) ;false sort highest first ) ) ) ) ) ) ) (foreach ent tlst This method has some handy caps. Entity's need to be in a grid and basically a straight line. example. if #2 is higher then 1 it will be first in the list.

Try this ;;Changing the width of all polylines to zero in all blocks in ;;the drawing if the thickness of the polylines is less than zero (DEFUN C:POLY0 (/ ACDC BNAME LSBLK REGE) (setq ACDC (vla-get-activedocument (vlax-get-acad-object))) (vlax-for el (vla-get-blocks ACDC) (setq BNAME (vla-get-name el)) (if (and (eq (vla-get-isxref el) :vlax-false) (eq (vla-get-islayout el) :vlax-false) (/= (substr BNAME 1 1) "*") (wcmatch BNAME "~*|*") (not (vl-position el LSBLK)) ) (setq LSBLK (cons el LSBLK)) ) ) (foreach Obj LSBLK (vlax-for Itm Obj (if (and (vlax-property-available-p Itm "ObjectName") (vlax-property-available-p Itm "Thickness") (= (strcase (vla-get-objectname Itm)) "ACDBPOLYLINE") (< (vla-get-thickness Itm) 0) ) (vla-put-constantwidth Itm (setq REGE 0)) ) ) ) (if REGE (vla-regen ACDC acallviewports)) (princ) ) ;;C:POLY0

These was installed on different computers I assume? or same computer different user logins? (hadn't logged out) If its the later id tell them to kick rocks. Move over to BricsCAD. They have Subscription, Perpetual, and Network licenses available. Are way cheaper then AutoCAD.

Plot "Extents" and select the "centre plot" option as you mentioned above.

Just change the ssget mode string. code updated.