Leaderboard

I just found out that Vladimir Nesterovsky write a r-ss-foreach function back in 1997. https://vnestr.tripod.com/Revpline.lsp It's almost identical to my foreach-ss function, so not sure if we can call it "more modern commands" anymore .

Wow.. I will, thank you. Rewriting the file is exactly what I need.

I am not trying to protect something. I need to upload to gov platform a dxf file and need to be hashcode SHA512 , and I am trying to do the job faster with a lisp.

It's always best to upload images directly to the forum. Here's an explanation on how to do that:

;; get the block table (block definitions collection) (setq blockTable (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) ;; get a block by name ;; (throws an error if the the block table does not contain a block names as blockName) (setq block (vla-Item blockTable blockName)) ;; get the block ObjectId (setq blockId (vla-get-ObjectId block)) ;in the table (vla-SetBlockTableRecordId table row colum blockId :vlax-true)

OP, I don't know how to implement blocks previews, but for BIGAL's suggestion here is my version that does the same thing without previews... (defun c:count-table-doortag ( / lst2table groupbynum assoc++ blk+tagname+tagval ss idx tmp xrf fil lst pt ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun lst2table ( lst pt / as cols rh cw ttl data rows sty tbl r k ) (setq rh (vla-gettextheight (setq sty (vla-item (vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) "acad_tablestyle") (getvar (quote ctablestyle)) ) ) acdatarow ) ) (setq pt (vlax-3d-point (trans pt 1 0))) (setq as (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))) (setq cols (if (listp (caadr lst)) (length (caadr lst)) (length (car lst)))) (setq ttl (if (not (listp (car lst))) (car lst))) (setq data (if (not (listp (car lst))) (cadr lst) lst)) (setq data (mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (if (null y) "" y))) x))) data)) (setq rows (if (not (listp (car lst))) (1+ (length data)) (length data))) (if ttl (vla-enablemergeall sty "Title" :vlax-true) (vla-enablemergeall sty "Title" :vlax-false) ) (setq cw (apply (function max) (mapcar (function (lambda ( x ) (strlen x))) (list "Preview" "Block Name" "DTYPE" "DSIZE" "Count")))) (setq tbl (vla-addtable as pt rows cols (* 2.5 rh) (* 0.8 cw))) (if (vlax-property-available-p tbl 'regeneratetablesuppressed t) (vla-put-regeneratetablesuppressed tbl :vlax-true) ) (vla-put-stylename tbl (getvar (quote ctablestyle))) (if ttl (progn (vla-settext tbl 0 0 ttl) (setq r 1) ) (setq r 0) ) (foreach i data (setq k -1) (foreach ii i (vla-settext tbl r (setq k (1+ k)) ii) (cond ( (and ttl (> r 1)) (vla-setcellalignment tbl r k acmiddleleft) ) ( (and (not ttl) (= r 0)) nil ) ( t (vla-setcellalignment tbl r k acmiddleleft) ) ) ) (setq r (1+ r)) ) (setq cw (apply (function max) (mapcar (function (lambda ( x ) (strlen x))) (list "Preview" "Block Name" "DTYPE" "DSIZE" "Count")))) (setq k -1) (repeat cols (vla-setcolumnwidth tbl (setq k (1+ k)) (* cw rh)) ) (if (vlax-property-available-p tbl (quote regeneratetablesuppressed) t) (vla-put-regeneratetablesuppressed tbl :vlax-false) ) (if (vlax-method-applicable-p tbl (quote scaleentity)) (vla-scaleentity tbl pt 50.0) ) (vla-update tbl) (princ) ) (defun groupbynum ( lst n / sub lll ) (defun sub ( m n / ll q ) (cond ( (and m (< (length m) n)) (repeat (- n (length m)) (setq m (append m (list nil))) ) (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m)) (setq lll (cons ll lll)) (setq q nil) (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n) ) ( m (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m)) (setq lll (cons ll lll)) (setq q nil) (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n) ) ( t (reverse lll) ) ) ) (sub lst n) ) (defun assoc++ ( key lst / itm ) (if (setq itm (assoc key lst)) (subst (cons key (1+ (cdr itm))) itm lst) (cons (cons key 1) lst) ) ) (defun blk+tagname+tagval ( ent / blk enx lst ) (setq blk (cdr (assoc 2 (entget ent)))) (while (= (cdr (assoc 0 (setq enx (entget (setq ent (entnext ent)))))) "ATTRIB") (setq lst (cons (list (cdr (assoc 2 enx)) (cdr (assoc 1 enx))) lst)) ) (cons blk lst) ) (while (setq tmp (tblnext "block" (null tmp))) (if (= 4 (logand 4 (cdr (assoc 70 tmp)))) (setq xrf (vl-list* "," (cdr (assoc 2 tmp)) xrf)) ) ) (if xrf (setq fil (list (cons 0 "INSERT") (cons -4 "<NOT") (cons 2 (apply (function strcat) (cdr xrf))) (cons -4 "NOT>") (cons 66 1))) (setq fil (list (cons 0 "INSERT") (cons 66 1))) ) (prompt "\nSelect attributed blocks <all>...") (if (not (setq ss (ssget fil))) (setq ss (ssget "_A" fil)) ) (repeat (setq idx (sslength ss)) (setq lst (assoc++ (blk+tagname+tagval (ssname ss (setq idx (1- idx)))) lst)) ) (setq lst (vl-sort lst (function (lambda ( a b ) (> (cdr a) (cdr b)))))) (setq lst (groupbynum (apply (function append) (mapcar (function (lambda ( x ) (cons "" (list (caar x) (cadr (cadar x)) (cadr (caddar x)) (itoa (cdr x)))))) lst)) 5)) (initget 1) (setq pt (getpoint "\nPick or specify point for table : ")) (lst2table (list "LEGEND" (append (list (list "Preview" "Block Name" "DTYPE" "DSIZE" "Count")) lst)) pt) (princ) ) I hope that this helps, if you don't care for previews... M.R.

Hello Slava_nikitin, welcome in the forum! Your links are broken, I can't see those screenshots. You get a Layout but no 3d? Just a guess: try to double-click a 2d representation -it should activate the viewport, if there is one- and next try to copy-paste. It would help us to have a dwg file to play with.

vl-string-search (or more accurately, vl-string-subst) isn't used to capture Regular Expression. It's meant to capture exact matches. I recommend using this function from Lee Mac: Parse Numbers After which, you can use this: (setq tst "12.43 93.32 hrui23 -43") (apply '+ (LM:parsenumbers tst)) However, if you must use regular expression, I have a small function that accomplishes this (although mine is widely case-insensitive): (defun JH:RegEx-Find (str pat / i j mch rtn s sub) (vlax-put-property (JH:Regex_Object) "Pattern" pat) (setq mch (vl-catch-all-apply 'vlax-invoke (list (JH:Regex_Object) "Execute" str))) (if (not (vl-catch-all-error-p mch)) (progn (vlax-for m mch (setq sub nil s (vlax-get-property m "SubMatches")) (repeat (setq i (vla-get-count s) j i) (setq sub (cons (vlax-variant-value (vlax-get-property s "Item" (- j i))) sub) i (1- i)) ) (setq rtn (cons (list (vla-get-value m) (reverse sub)) rtn)) ) (reverse rtn) ) ) ) (defun JH:Regex_Object ( / rx) (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (vlax-put-property rx "Global" :vlax-true) (vlax-put-property rx "Multiline" :vlax-true) (vlax-put-property rx "IgnoreCase" :vlax-false) (eval (list 'defun 'JH:Regex_Object '() rx ) ) (JH:Regex_Object) ) After which, you can call it like this: (setq tst "12.43 93.32 hrui23 -43") (apply '+ (mapcar 'distof (mapcar 'car (JH:Regex-Find tst "[-\\+]?\\d+(\\.\\d+)?" ) ) ) )

Try this: ;; All to RGB - Lee Mac - www.lee-mac.com ;; Converts the ACI colours of all entities to the RGB TrueColor equivalent (defun c:AlltoRGB ( / accm c e i s ) (if (and (setq s (ssget "_:L")) (setq accm (vla-getinterfaceobject (vlax-get-acad-object) (strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2)) ) ) ) (progn (repeat (setq i (sslength s)) (setq e (entget (ssname s (setq i (1- i))))) (if (setq c (cdr (assoc 62 e))) (progn (vla-put-colorindex accm c) (entmod (append e (list (cons 420 (LM:RGB->True (vla-get-red accm) (vla-get-green accm) (vla-get-blue accm) ) ) ) ) ) ) ) ) (vlax-release-object accm) ) ) (princ) ) ;; RGB -> True - Lee Mac 2011 ;; Args: r,g,b - Red,Green,Blue values (defun LM:RGB->True ( r g b ) (+ (lsh (fix r) 16) (lsh (fix g) 8) (fix b) ) ) (vl-load-com) (princ) It will change the colour of selected entities from the ACI colour to the RGB True Colour equivalent. Note that it will change only those entities whose colour is not set to ByLayer (though these may be included if necessary by changing the respective layer colours). More Colour Conversion functions.