Leaderboard

Couple of points where drawing history can fail: If the 'creator' is modifying a source file, then the source file creator might be credited with creation If the file has been 'saved as', then it is a new file, and drawing history is reset to that point If the file is copied and pasted in windows, again new file, new history If the file is e-mailed to you I think, then what you get is a new file - new history It looks like this is a windows feature that AutoCAD reads rather than a function of the CAD file, so the history is only there so long as it is the same file. Using Windows to see if they created it on their computer, you would need access to their computer to do that I think (might have to look in the temporary files folder?), a shared drive you can look at but they will only tell you the user that modified the file (could be any network computer). Your network administrators have more access privileges and might be able to look further than you can

I tend to use short defun names or you can have shortcuts to a long defun name, these are in a Autoload.lsp which is loaded on startup. For me LLL a simple command. (defun c:lll ()(c:listlengths)) Some of my defuns are like 47 which sets osnaps to what I like to use, can have L1 L2 etc. I try to stay away from using numbers for say 20 lisps would be like 10, 11 -> 31 hard to remember which number to use. There is plenty of software that use function numbers as shortcuts.

(vl-load-com) (defun c:wrap ( / acdoc *error* oldcmdecho ss0 ssl0 index ent bb ss ssl ptlist elist pt1 ptlist chlist chent textflag obj box lll url ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq oldcmdecho (getvar 'cmdecho)) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (vla-EndUndoMark acdoc) (setvar 'cmdecho oldcmdecho) (princ) ) (defun LWPolybylist (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) ) ) ) (vla-StartUndoMark acdoc) (setvar 'cmdecho 0) (setq ss0 (ssget)) (setq ssl0 (sslength ss0)) (setq index 0) (setq textflag 0) (setq ptlist '()) (repeat ssl0 (setq ent (ssname ss0 index)) (setq elist (entget ent)) (if (or (eq (cdr (assoc 0 elist)) "TEXT") (eq (cdr (assoc 0 elist)) "MTEXT") (eq (cdr (assoc 0 elist)) "INSERT")) (progn (setq textflag 1) (setq obj (vlax-ename->vla-object ent)) (setq box (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) ; lower left point (setq url (vlax-safearray->list ur)) ; upper right point (setq ent (LWPolybylist (list lll (list (car url) (cadr lll)) url (list (car lll) (cadr url))) 1)) ) (progn ) ) (setq ptlist (append (LM:ent->pts ent 100) ptlist)) ;(command "_.DIVIDE" ent 100 "") (if (= textflag 1) (entdel ent) ) (setq textflag 0) (setq index (+ index 1)) ) (setvar 'cmdecho oldcmdecho) (setq bb (LM:ssboundingbox ss0)) ;(if (setq ss (ssget "_C" (car bb) (cadr bb) '((0 . "POINT")))) ; (progn ; (setq ssl (sslength ss)) ; (setq index 0) ; (repeat ssl ; (setq ent (ssname ss index)) ; (setq elist (entget ent)) ; (setq pt1 (cdr (assoc 10 elist))) ; (setq ptlist (cons pt1 ptlist)) ; (entdel ent) ; (setq index (+ index 1)) ; ) ; ) ;) ;(princ ptlist) (setq chlist (LM:ConvexHull ptlist)) (setq chent (entmakex (append (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length chlist)) '(070 . 1) ) (mapcar '(lambda ( x ) (cons 10 x)) chlist) ) ) ) (vla-EndUndoMark acdoc) (princ) ) ;; Convex Hull - Lee Mac ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points. (defun LM:ConvexHull ( lst / ch p0 ) (cond ( (< (length lst) 4) lst) ( (setq p0 (car lst)) (foreach p1 (cdr lst) (if (or (< (cadr p1) (cadr p0)) (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0))) ) (setq p0 p1) ) ) (setq lst (vl-sort lst (function (lambda ( a b / c d ) (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8) (< (distance p0 a) (distance p0 b)) (< c d) ) ) ) ) ) (setq ch (list (caddr lst) (cadr lst) (car lst))) (foreach pt (cdddr lst) (setq ch (cons pt ch)) (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt)) (setq ch (cons pt (cddr ch))) ) ) ch ) ) ) ;; Clockwise-p - Lee Mac ;; Returns T if p1,p2,p3 are clockwise oriented or collinear (defun LM:Clockwise-p ( p1 p2 p3 ) (< (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1))) ) 1e-8 ) ) ;; Selection Set Bounding Box - Lee Mac ;; Returns a list of the lower-left and upper-right WCS coordinates of a ;; rectangular frame bounding all objects in a supplied selection set. ;; sel - [sel] Selection set for which to return bounding box (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp ) (repeat (setq idx (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) ) (setq ls1 (cons (vlax-safearray->list llp) ls1) ls2 (cons (vlax-safearray->list urp) ls2) ) ) ) (if (and ls1 ls2) (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) ) ) ;; Entity to Point List - Lee Mac ;; Returns a list of WCS points describing or approximating the supplied entity, else nil if the entity is not supported. ;; ent - [ent] Entity name to be described by point list (POINT/LINE/ARC/CIRCLE/LWPOLYLINE/POLYLINE/ELLIPSE/SPLINE) ;; acc - [num] Positive number determining the point density for non-linear objects (defun LM:ent->pts (ent acc / ang bul cen cls di1 di2 enx inc itm lst num ocs rad tot typ vt1 vt2 vtl ) (setq enx (entget ent) typ (cdr (assoc 0 enx)) ) (cond ((= "POINT" typ) (list (cdr (assoc 10 enx))) ) ((= "LINE" typ) (mapcar '(lambda (x) (cdr (assoc x enx))) '(10 11)) ) ((or (= "ARC" typ) (= "CIRCLE" typ)) (if (= "ARC" typ) (setq ang (cdr (assoc 50 enx)) tot (rem (+ pi pi (- (cdr (assoc 51 enx)) ang)) (+ pi pi)) num (fix (+ 1.0 1e-8 (* acc (/ tot (+ pi pi))))) inc (/ tot (float num)) num (1+ num) ) (setq ang 0.0 tot (+ pi pi) num (fix (+ 1e-8 acc)) inc (/ tot (float num)) ) ) (setq cen (cdr (assoc 010 enx)) rad (cdr (assoc 040 enx)) ocs (cdr (assoc 210 enx)) ) (repeat num (setq lst (cons (trans (polar cen ang rad) ocs 0) lst) ang (+ ang inc) ) ) (reverse lst) ) ((or (= "LWPOLYLINE" typ) (and (= "POLYLINE" typ) (zerop (logand (logior 16 64) (cdr (assoc 70 enx)))) ) ) (if (= "LWPOLYLINE" typ) (setq vtl (LM:ent->pts:lwpolyvertices enx)) (setq vtl (LM:ent->pts:polyvertices ent)) ) (if (setq ocs (cdr (assoc 210 enx)) cls (= 1 (logand 1 (cdr (assoc 70 enx)))) ) (setq vtl (append vtl (list (cons (caar vtl) 0.0)))) ) (while (setq itm (car vtl)) (setq vtl (cdr vtl) vt1 (car itm) bul (cdr itm) lst (cons (trans vt1 ocs 0) lst) ) (if (and (not (equal 0.0 bul 1e-8)) (setq vt2 (caar vtl))) (progn (setq rad (/ (* (distance vt1 vt2) (1+ (* bul bul))) 4.0 bul) cen (polar vt1 (+ (angle vt1 vt2) (- (/ pi 2.0) (* 2.0 (atan bul)))) rad ) rad (abs rad) tot (* 4.0 (atan bul)) num (fix (+ 1.0 1e-8 (* acc (/ (abs tot) (+ pi pi))))) inc (/ tot (float num)) ang (+ (angle cen vt1) inc) ) (repeat (1- num) (setq lst (cons (trans (polar cen ang rad) ocs 0) lst) ang (+ ang inc) ) ) ) ) ) (reverse (if cls (cdr lst) lst)) ) ((= "ELLIPSE" typ) (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent)) di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) di2 (- di2 1e-8) ) (while (< di1 di2) (setq lst (cons (vlax-curve-getpointatdist ent di1) lst) rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatdist ent di1 ) ) ) di1 (+ di1 (/ di2 (1+ (fix (* acc (/ di2 rad (+ pi pi))))))) ) ) (reverse (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)) ) ) ((= "SPLINE" typ) (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent)) di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) lst (list (vlax-curve-getstartpoint ent)) inc (/ (- di2 di1) (float acc)) di1 (+ di1 inc) ) (repeat (1- (fix (+ 1e-8 acc))) (setq lst (cons (vlax-curve-getpointatdist ent di1) lst) di1 (+ di1 inc) ) ) (reverse (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)) ) ) ) ) (defun LM:ent->pts:lwpolyvertices (enx / elv lst vtx) (setq elv (list (cdr (assoc 38 enx)))) (while (setq vtx (assoc 10 enx)) (setq enx (cdr (member vtx enx)) lst (cons (cons (append (cdr vtx) elv) (cdr (assoc 42 enx))) lst) ) ) (reverse lst) ) (defun LM:ent->pts:polyvertices (ent / lst vte vtx) (setq vte (entnext ent) vtx (entget vte) ) (while (= "VERTEX" (cdr (assoc 0 vtx))) (setq lst (cons (cons (cdr (assoc 10 vtx)) (cdr (assoc 42 vtx))) lst) vte (entnext vte) vtx (entget vte) ) ) (reverse lst) ) this routine wraps edges together rather than connecting right angle extension lines, so it may not suit your purpose..... so this is just for reference. I personally used this when I wanted to combine separate areas while using UNION for REVCLOUD command.