Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 04/08/2019 in all areas

  1. @Emmanuel Delay Sorry, it was some mistake from my side, now it's working absolutely fine. Much thanks for your help and effort.
    1 point
  2. You need to save the multi lisps to a directory that is in your search path.I have a directory of all my lisps. CONFIG Files Support path I just tested on a simple single attribute block, if your block has more than one attribute may be a problem. Post a dwg with your block
    1 point
  3. Copy and move (defun c:ssct (/ ss pt1 pt2 layer2) (setq layer2 (getstring "\nEnter layer name")) (setq ss (ssget '((0 . "*Text")))) (setq pt1 (getpoint "\npick start point ")) (setq pt2 (getpoint pt1 "\npick end point")) (repeat (setq x (sslength ss)) (command "copy" (ssname ss (setq x (- x 1))) "" pt1 pt2) (command "chprop" (entlast) "" "la" Layer2 "" ) ) )
    1 point
  4. A shorter version with a + - dcl The pt num bubble may be usefull does circles and squares A B C 1 2 3 etc ; Add or subtract a number from the 1st attributes ; BY alan H April 2019 (defun c:ahadd1 ( / obj txt txtr atts) (setq obj (vlax-ename->vla-object (car (entsel "Pick block")))) (if (/= (setq atts (vlax-invoke obj "getattributes")) nil) (progn (setq txt (vla-get-textstring (nth 0 atts))) (setq txtr (atof txt)) (if (not AH:Butts)(load "Multi radio buttons.lsp")) (if (= but nil)(setq but 1)) ; this is needed to set default button (setq ans (ah:butts but "V" '("Add or subtract" "+" "-"))) (if (= ans "+") (setq txtr (+ txtr 1)) (setq txtr (- txtr 1)) ) (vla-put-textstring (nth 0 atts) (rtos txtr 2 0)) ) (alert "Block has no attributes try again") ) (princ) ) (c:ahadd1) Multi radio buttons.lsp Pt num bubble.lsp
    1 point
  5. You need to loop through the selection set You can either (defun c:ssct (/ ss cnt obj n_obj) (setq ss (ssget '((0 . "*Text") (8 . "layer1")))) (repeat (setq cnt (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))) n_obj (vla-copy obj) ) (vlax-put-property n_obj 'layer "layer2") ) ) or (defun c:ssct (/ ss cnt sel) (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) ss (ssget '((0 . "*Text") (8 . "layer1"))) ) (vlax-for obj (vla-get-activeselectionset c_doc) (setq n_obj (vla-copy obj)) (vlax-put-property n_obj 'layer "layer2") ) ) The text will exactly overwrite the existing text so you will have two text items at each location. Did you by change mean to copy and move?
    1 point
  6. Sure. I will assume there is only 1 attribute per block. But it doesn't matter what the tag is now. ;; Get Attribute Values - Lee Mac ;; Returns an association list of attributes present in the supplied block. ;; blk - [ent] Block (Insert) Entity Name ;; Returns: [lst] Association list of ((<tag> . <value>) ... ) (defun LM:getattributevalues ( blk / enx lst ) (while (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (setq lst (cons (cons (cdr (assoc 2 enx)) (cdr (assoc 1 (reverse enx))) ) lst ) ) ) (reverse lst) ) ;; Set Attribute Values - Lee Mac ;; Sets attributes with tags found in the association list to their associated values. ;; blk - [ent] Block (Insert) Entity Name ;; lst - [lst] Association list of ((<tag> . <value>) ... ) ;; Returns: nil (defun LM:setattributevalues ( blk lst / enx itm ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (setq itm (assoc (cdr (assoc 2 enx)) lst)) (progn (if (entmod (subst (cons 1 (cdr itm)) (assoc 1 (reverse enx)) enx)) (entupd blk) ) (LM:setattributevalues blk lst) ) (LM:setattributevalues blk lst) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Increment Decrement Attribute (defun c:ida ( / tag ent pp inc attr val) (while (setq ent (entsel "\nClick right of the circle/block to increment, left to decrement: ")) (setq pp (cadr ent)) (setq inc (- (nth 0 pp) ;; pick point, x value (nth 0 (cdr (assoc 10 (entget (car ent))))) ;; IP, x value ) ) ;; read the attributes; I only expect 1 (setq attr (LM:getattributevalues (car ent))) (setq tag (nth 0 (nth 0 attr))) (setq val (atoi (cdr (assoc tag attr)))) (if (> inc 0.0) (LM:setattributevalues (car ent) (list (cons tag (itoa (+ val 1))))) (LM:setattributevalues (car ent) (list (cons tag (itoa (- val 1))))) ) ) (princ) )
    1 point
×
×
  • Create New...