Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 02/26/2019 in all areas

  1. Here is a quick one .. all objects must be on screen. (defun c:foo (/ e p s) (cond ((and (setq e (car (entsel "\nPick a polyline: "))) (setq p (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x)))(entget e)))) (setq s (ssget "_F" p)) ) (print (1- (sslength s))) (sssetfirst nil s) ) ) (princ) )
    1 point
  2. 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.
    1 point
  3. 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.
    1 point
  4. (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) )
    1 point
  5. Actually you did one more - self redefining function, but it seems too complex for your "Prompting with a Default Option" tutorial.
    1 point
  6. Here's a tutorial describing various ways to achieve this - I believe you're interested in what I refer to as the "Dynamic Default".
    1 point
  7. FWIW, this may be the function that you were referring to. Nice one Ron
    1 point
  8. Go HERE and start learning how to troubleshoot
    1 point
  9. 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))
    1 point
  10. 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) )
    1 point
×
×
  • Create New...