Leaderboard

Just a suggestion rather than commenting out the Acad / Bricscad use (vlax-product-key) in an IF with Wcmatch looking for Bricsys or BricsCAD then code works in Both.

Here is the final code (see the different between autocad and bricscad in the code): (defun c:ReplaceBlockS () (c:RBS)) (defun c:RBS (/ answr ent idx newblock newname blk newblock obj ss M1 M2 M3 C1 C2 C3 E1 E2 E3 ITD GR ORD QTY QTY1 SYS UN MANDIA MANGR x) (vl-load-com) (setq temperr *error*);;store *error* (setq *error* trap1);;re-assign *error* (setvar "CMDECHO" 0) (command ".undo" "be") (setvar "CMDECHO" 1) (princ) (prompt "\nselect blocks,Enter To End Selection") ;;if the user selects something, inputs a ne block name AND it exists in the dwg... (if (and (setq ss (ssget '((0 . "INSERT")))) ;; (ssget ":S" '((0 . "INSERT"))) ;;(setq newblock (entget (car (entsel "\nPick instance of new block: ")))) ;;Autocad (setq newblock (entsel "\nPick instance of new block: ")) ;;Bricscad (setq newname (getpropertyvalue (car newblock) "EffectiveName~Native")) ;;Bricscad ;;(setq newname (cdr (assoc 2 newblock))) ;;Autocad (tblobjname "BLOCK" newname) (vl-catch-all-apply (setq M1 (LM:getattributevalue (car newblock) "MAN1"))) (vl-catch-all-apply (setq M2 (LM:getattributevalue (car newblock) "MAN2"))) (vl-catch-all-apply (setq M3 (LM:getattributevalue (car newblock) "MAN3"))) (vl-catch-all-apply (setq C1 (LM:getattributevalue (car newblock) "CAT1"))) (vl-catch-all-apply (setq C2 (LM:getattributevalue (car newblock) "CAT2"))) (vl-catch-all-apply (setq C3 (LM:getattributevalue (car newblock) "CAT3"))) (vl-catch-all-apply (setq E1 (LM:getattributevalue (car newblock) "ERP1"))) (vl-catch-all-apply (setq E2 (LM:getattributevalue (car newblock) "ERP2"))) (vl-catch-all-apply (setq E3 (LM:getattributevalue (car newblock) "ERP3"))) (vl-catch-all-apply (setq ITD (LM:getattributevalue (car newblock) "ITEM_DESCRIPTION"))) (vl-catch-all-apply (setq GR (LM:getattributevalue (car newblock) "GRUOP"))) (vl-catch-all-apply (setq UN (LM:getattributevalue (car newblock) "UNIT"))) (vl-catch-all-apply (setq MANDIA (LM:getattributevalue (car newblock) "MANIFOLD_DIA"))) (vl-catch-all-apply (setq MANGR (LM:getattributevalue (car newblock) "MANIFOLD_GRUOP"))) ;;(vl-catch-all-apply (setq ORD (LM:getattributevalue (car newblock) "ORDER"))) ;; don't change ;;(vl-catch-all-apply (setq SYS (LM:getattributevalue (car newblock) "SYSTEM"))) ;; don't change (vl-catch-all-apply (setq QTY (LM:getattributevalue (car newblock) "QUANTITY"))) ;; don't change ;; (setq M2 (strcase (vla-get-tagstring "MAN2"))) ;; (setq M3 (strcase (vla-get-tagstring "MAN3"))) ;; (setq C1 (strcase (vla-get-tagstring "CAT1"))) ;; (setq C2 (strcase (vla-get-tagstring "CAT2"))) ;; (setq C3 (strcase (vla-get-tagstring "CAT3"))) ;; (setq E1 (strcase (vla-get-tagstring "ERP1"))) ;; (setq E2 (strcase (vla-get-tagstring "ERP2"))) ;; (setq E3 (strcase (vla-get-tagstring "ERP3"))) ;; (setq ITD (strcase (vla-get-tagstring "ITEM_DESCRIPTION"))) ;; (setq GR (strcase (vla-get-tagstring "GRUOP"))) ;; (setq ORD (strcase (vla-get-tagstring "ORDER"))) ;; (setq QTY (strcase (vla-get-tagstring "QUANTITY"))) ;; (setq SYS (strcase (vla-get-tagstring "SYSTEM"))) ;; (setq UN (strcase (vla-get-tagstring "UNIT"))) ;; (setq MANDIA (strcase (vla-get-tagstring "MANIFOLD_DIA"))) ;; (setq NANGR (strcase (vla-get-tagstring "MANIFOLD_GRUOP"))) ) (progn (setq idx -1) (while (setq ent (ssname ss (setq idx (1+ idx)))) (setq obj (vlax-ename->vla-object ent)) (vla-put-name obj newname);;change the name (if (setq x (getpropertyvalue ent "d1")) (progn (vl-catch-all-apply (setq QTY1 (LM:getattributevalue ent "QUANTITY"))) (vl-catch-all-apply (setq QTY1 (* 1000 (atof QTY1)))) (vl-catch-all-apply (setq QTY1 (rtos QTY1 2 3))) (vl-catch-all-apply (setpropertyvalue ent "d1" QTY1)) ) ) (vl-catch-all-apply (LM:setattributevalue ent "MAN1" M1)) (vl-catch-all-apply (LM:setattributevalue ent "MAN2" M2)) (vl-catch-all-apply (LM:setattributevalue ent "MAN3" M3)) (vl-catch-all-apply (LM:setattributevalue ent "CAT1" C1)) (vl-catch-all-apply (LM:setattributevalue ent "CAT2" C2)) (vl-catch-all-apply (LM:setattributevalue ent "CAT3" C3)) (vl-catch-all-apply (LM:setattributevalue ent "ERP1" E1)) (vl-catch-all-apply (LM:setattributevalue ent "ERP2" E2)) (vl-catch-all-apply (LM:setattributevalue ent "ERP3" E3)) (vl-catch-all-apply (LM:setattributevalue ent "ITEM_DESCRIPTION" ITD)) (vl-catch-all-apply (LM:setattributevalue ent "GRUOP" GR)) (vl-catch-all-apply (LM:setattributevalue ent "UNIT" UN)) (vl-catch-all-apply (LM:setattributevalue ent "MANIFOLD_DIA" MANDIA)) (vl-catch-all-apply (LM:setattributevalue ent "MANIFOLD_GRUOP" MANGR)) ;;(vl-catch-all-apply (LM:setattributevalue ent "ORDER" ORD)) ;; DON'T CHANGE ;;(vl-catch-all-apply (LM:setattributevalue ent "QUANTITY" QTY)) ;; DON'T CHANGE ;;(vl-catch-all-apply (LM:setattributevalue ent "SYSTEM" SYS)) ;; DON'T CHANGE ;;(vla-put-textstring "MAN1" M1) ;;(vla-put-textstring "MAN2" M2) ;;(vla-put-textstring "MAN3" M3) ;;(vla-put-textstring "CAT1" C1) ;;(vla-put-textstring "CAT2" C2) ;;(vla-put-textstring "CAT3" C3) ;;(vla-put-textstring "ERP1" E1) ;;(vla-put-textstring "ERP2" E2) ;;(vla-put-textstring "ERP3" E3) ;;(vla-put-textstring "ITEM_DESCRIPTION" ITD) ;;(vla-put-textstring "GRUOP" GR) ;;(vla-put-textstring "ORDER" ORD) ;;(vla-put-textstring "QUANTITY" QTY) ;;(vla-put-textstring "SYSTEM" SYS) ;;(vla-put-textstring "UNIT" UN) (vla-update obj) ) ) ) (command ".undo" "end") (princ (strcat "\nReplaced " (itoa idx) " blocks......")) (princ) ) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [ent] Block (Insert) Entity Name ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:getattributevalue ( blk tag / val enx ) (while (and (null val) (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))) ) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (setq val (cdr (assoc 1 (reverse enx)))) ) ) ) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [ent] Block (Insert) Entity Name ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:setattributevalue ( blk tag val / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx)) (progn (entupd blk) val ) ) (LM:setattributevalue blk tag val) ) ) ) 2 comments: 1. the reason for the vl-catch-all-apply is that some of my blocks contain 2 more tags so I need the lisp to work on both types. 2. I could'nt update the parametric blocks parameter "d1" (see the second part of the lisp). if some one can look on it and help me find a solution it will be nice... thanks, aridzv.

My function will not error if the supplied attribute tag does not exist - it will simply return nil. As such, you can test for returned value using a simple if statement, e.g.: (if (setq value (LM:getattributevalue (car blk1) "MAN11")) ;; do stuff )

Ok understand what you want and a simple answer is to duplicate the text onto a different layer and rotate3d that text. Then you can turn off plan view text and see Front text. Having worked with 3d points re CIV3D you will still have a mess when it comes to reading the points and text form a front view. Anyway try this on a few points. (defun c:wow ( / ss ent obj ) (command "layer" "M" "TEXTfront" "") (prompt "Select Text") (setq ss (ssget '((0 . "TEXT")))) (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (1- x)))) (setq obj (vlax-ename->vla-object ent)) (setq inspt (vlax-get obj 'insertionpoint)) (command "copy" ent "" "0,0,0" "0,0,0") (setq obj (vlax-ename->vla-object (entlast))) (vlax-put obj 'layer "TEXTfront") (vlax-put obj 'normal '(0 -1 0)) (vlax-put obj 'insertionpoint inspt) ) (princ) )

(apply 'max a) will always be the quickest, but will be susceptible to the inherent limitation in the number of arguments that you can supply to the min or max functions, and will therefore fail for long lists; other alternatives which avoid this limit might be: (car (vl-sort a '>)) But sorting is also unnecessarily slow - on average on the order of O(n log(n)) when only a maximum is required, and so this method should be avoided. Another alternative might be: (setq r (car a)) (foreach x (cdr a) (if (< r x) (setq r x)))

hi.. i have some lisps every time i need them.. i want those lisps loading when i open auto cad. and how i creat a tool bar with icons for those lisps.. thank u.