Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 03/31/2023 in all areas

  1. (setq l '("A-4" "A-5")) (setq ssl (ssget "_X" (list '(8 . "A-*") '(-4 . "<NOT") (cons 8 (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) l))) '(-4 . "NOT>") '(410 . "Model") ) ) )
    2 points
  2. I have a LISP Routine that I found on here that sets all objects within blocks in the drawing to layer 0 then i purge out those layers. (defun c:norm (/ *error* adoc lst_layer func_restore-layers) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vl-load-com) (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (if (and (not (vl-catch-all-error-p (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not selset ) ;_ end of and (progn (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of vlax-for (foreach blk_def (mapcar (function (lambda (x) (vla-item (vla-get-blocks adoc) x) ) ;_ end of lambda ) ;_ end of function ((lambda (/ res) (foreach item (mapcar (function (lambda (x) (vla-get-name (vlax-ename->vla-object x) ) ;_ end of vla-get-name ) ;_ end of lambda ) ;_ end of function ((lambda (/ tab item) (repeat (setq tab nil item (sslength selset) ) ;_ end setq (setq tab (cons (ssname selset (setq item (1- item)) ) ;_ end of ssname tab ) ;_ end of cons ) ;_ end of setq ) ;_ end of repeat tab ) ;_ end of lambda ) ) ;_ end of mapcar (if (not (member item res)) (setq res (cons item res)) ) ;_ end of if ) ;_ end of foreach (reverse res) ) ;_ end of lambda ) ) ;_ end of mapcar (vlax-for ent blk_def (vla-put-layer ent "0") (vla-put-color ent 0) (vla-put-lineweight ent aclnwtbyblock) (vla-put-linetype ent "byblock") ) ;_ end of vlax-for ) ;_ end of foreach (func_restore-layers) (vla-regen adoc acallviewports) ) ;_ end of progn ) ;_ end of if (vla-endundomark adoc) (princ) ) ;_ end of defun If that doesn't work you can run purge then at the top click onto "find Non-Purgeable Items" and in the details of the selected layer it should tell you if anything is still hiding on the layer you dont want and usually where to find it. hopefully this helps.
    1 point
  3. Sure - try the following: (defun c:demo ( / i l n s x ) (if (setq s (ssget "_:L" '((8 . "?*-DEMO")))) (repeat (setq i (sslength s)) (setq x (vlax-ename->vla-object (ssname s (setq i (1- i)))) l (vla-get-layer x) n (substr l 1 (- (strlen l) 5)) ) (if (checkmakelayer l n) (vla-put-layer x n)) ) ) (princ) ) (defun checkmakelayer ( a b / c ) (cond ( (tblsearch "layer" b)) ( (setq a (tblobjname "layer" a)) (setq a (entget a) c (abs (cdr (assoc 62 a))) ) (entmake (subst (cons 2 b) (assoc 2 a) (subst (cons 62 (if (< c 9) (+ c 200) c)) (assoc 62 a) (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a) ) ) ) ) ) ) (vl-load-com) (princ)
    1 point
  4. Hi Phil, Thanks for the reply/info. The PC is an i9-12900/64Gb ram/Geforce 3060ti 8Gb, but I did have other programs running at the same time, one is VERY memory hungry so probably the cause. SteveN
    1 point
  5. I agree with mhupp to minimize the use of command functions , just wanted to stay as close to the original coding as possible because OP is making first steps on the road to eternal lisp glory and didn't want to overload or scare OP away
    1 point
  6. A macro in Notepad++ replace " " with " " etc Oh yeah "\t" " ".
    1 point
  7. 1.4 was like the 1st Acad. Running on NEC twin 8" disc pc, Color and a green screen.
    1 point
  8. Welcome. While using comman in lisp is convent I find its where the issues arise in the code so i try not to use it when i can. and since your using visual lisp to change the txt why not try an use it everywhere! Also I like to use foreach instead of the counting method. (setq i (1+ i)) nothing wrong with that tho. (defun c:xrde2 (/ doc strlay objtxt ss ent) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (if (setq strlay (ssget "_X" '((0 . "*TEXT") (8 . "B-??-??-TOPOGRAFIE-T18")))) (progn (foreach objtxt (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex strlay)))) (vla-put-textstring objTxt (strcase (vla-get-textstring objTxt))) ) (princ (strcat "\nCapatlized " (itoa (sslength strlay)) " text Stings")) ) (princ "\nSorry, no Text Found") ) (if (setq ss (ssget "_X" '((0 . "HATCH") (8 . "~*WATER*-V")))) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (entdel ent) ) ) (vla-save doc) (vla-EndUndoMark doc) (princ "\nDoei") (princ) )
    1 point
  9. This caused by the change to the forum software which removed all instances of "8)" from code... I've now updated my earlier post.
    1 point
  10. I found several problems and confusion with your code so I just rewrote it. Give this a try (minimally tested): NOTES: I changed variable names for 1) don't make variable names the same as an existing command, and 2) keep them shorter; they take up less memory. (defun c:MTP (/ cEnt elst txt clr ss i txtsz) (if (and (setq cEnt (car (nentsel "\nSelect Source Text: "))) (member (cdr (assoc 0 (entget cEnt))) '("TEXT" "MTEXT" "ATTRIB")) ) (progn (setq elst (entget cEnt) txt (assoc 1 elst) ; Get Text content clr (cond ((assoc 62 elst))(T '(62 . 256))); Get ACI color txtsz (assoc 40 elst) ; get text size ) (redraw cEnt 3) (if (setq ss (ssget '((0 . "TEXT,MTEXT")))) (repeat (setq i (sslength ss)) (setq elst (entget (ssname ss (setq i (1- i)))) ;Get Entity List elst (subst txt (assoc 1 elst) elst) ;Substitute test content in elist elst (if (assoc 62 elst) (subst clr (assoc 62 elst) elst)(append elst (list clr))) ;Substitute ACI color in elist elst (if (assoc 40 elst) (subst txtsz (assoc 40 elst) elst)(append elst (list txtsz))) ;substitute Text Height in elist ) (entmod elst) ; Modify new list ) ) ) ) (command "_regenall") (princ) )
    1 point
  11. Don't know what your where trying but this should work. (if (setq ssL (ssget "_X" '((8 . "A-*")(-4 . "<NOT")(8 . "A-4,A-5")(-4 . "NOT>")(410 . "Model")))) ;Do stuff ) -Edit for each layer you want to ignore just add it into the middle (8 . "layer1,layer2,layer3,layer4,layer5") Also worth a look. (if (setq ssL (ssget "_X" '((8 . "A-*")(-4 . "<NOT")(8 . "A-#")(-4 . "NOT>")(410 . "Model")))) This would ignore layers A-0, A-1, A-2, A-3, A-4, A-5, A-6, A-7, A-8, & A-9
    1 point
  12. 1 point
×
×
  • Create New...