Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/25/2025 in all areas

  1. I would add: ; Original by Emmanuel Delay + additions (defun c:MuOffLay ( / ss pt3 i off_dst obj elast pickset1 old_dst str_prompt) ;; creating a new layer (if (not (tblsearch "LAYER" "OffsetLines")) (command "_-layer" "_make" "OffsetLines" "_color" "1" "OffsetLines" "") ) ;; memorizing the distance (setq old_dst (getenv "MULTIOFF_LASTDST")) (if old_dst (progn (setq str_prompt (strcat " Offset Distance <" old_dst ">: ")) (setq off_dst (getreal str_prompt)) (if (not off_dst) (setq off_dst (atof old_dst)) ) ) (setq off_dst (getdist " Offset Distance: ")) ) (setenv "MULTIOFF_LASTDST" (rtos off_dst 2 3)) (setq pt3 (getpoint " Offset point: ")) (setq pickset1 (ssadd)) (princ " Select objects: ") (setq ss (ssget)) (setq i 0) (while (< i (sslength ss)) (setq obj (ssname ss i)) (command "_.offset" off_dst obj pt3 "") (setq elast (entlast)) (command "_.chprop" elast "" "_la" "OffsetLines" "_color" "1" "") (ssadd elast pickset1) (setq i (1+ i)) ) (sssetfirst nil pickset1) (princ) )
    2 points
  2. In the future please use Code Tags for your code. (<> in the editor toolbar)
    1 point
  3. Just sharing a simple script I just wrote, I don't have a question When drawing the hidden lines of stairs steps (the overlap of the lower step hidden under the step above) I thought: I would like to select all the steps; multi offset them; the offset lines should be selected and gripped, so that I can set them in a different layer (a layer with LType Hidden) ... But feel free to comment, improve, ... ;; Multi Offset. New objects get selected and gripped. ;; For example to make the hidden stairs steps... Select all (defun c:moff ( / sel ss pt3 i off_dst obj elast pickset1) (setq off_dst (getdist "\nOffset Distanct: ")) (setq pt3 (getpoint "\nOffset point: ")) (setq pickset1 (ssadd)) (princ "\nSelect objects: ") (setq ss (ssget)) (setq i 0) (repeat (sslength ss) (setq obj (ssname ss i)) (command "offset" off_dst obj pt3 "") (setq elast (entlast)) ;; (ssadd elast pickset1) (setq i (+ i 1)) ) ;; now grip the pickset (the newly made objects) (sssetfirst nil pickset1) )
    1 point
  4. And this is the small variation that best fits what @leonucadomi is asking for, I think. With the peculiarity that the "jog" will be placed where the selection is made with the pickbox. ; Original by RonJonP, edited by P. Kenewell and GLAVCVS (defun c:ltx (/ e o s le to l) (setvar "cmdecho" 0) (command "._undo" "_be") (while (and (setq e (car (setq l (entsel "\rSelect a TEXT, MTEXT or DIMENSION...")))) (wcmatch (cdr (assoc 0 (setq le (entget e)))) "*TEXT,DIMENSION")) (setq o (vlax-ename->vla-object e)) (cond ((= "TEXT" (setq to (cdr (assoc 0 le)))) (vla-put-textstring o (strcat "%%O" (vl-string-subst "" "" (vl-string-subst "" "%%O" (vla-get-textstring o)) ) ) ) ) ((= "MTEXT" to) (vla-put-textstring o (strcat "\\O" (vl-string-subst "" "" (vl-string-subst "" "\\O" (vla-get-textstring o)) ) ) ) ) ((= "DIMENSION" to) (if (not (tblsearch "APPID" "ACAD_DSTYLE_DIMJAG_POSITION")) (regapp "ACAD_DSTYLE_DIMJAG_POSITION") ) (entmod (append le (list (list -3 (list "ACAD_DSTYLE_DIMJAG_POSITION" '(1070 . 387) '(1070 . 3) '(1070 . 389) (cons 1010 (cadr l))))))) (if (= (vla-get-textoverride o) "") (vla-put-textoverride o "\\O<>") (vla-put-textoverride o (strcat "\\O" (vl-string-subst "" "" (vl-string-subst "" "\\O" (vla-get-textoverride o)) ) ) ) ) ) ) ) (command "._undo" "_end") (setvar "cmdecho" 1) (princ) )
    1 point
  5. Here's another that matches some properties of the replaced block: (defun c:foo (/ _dxf e o o2 p s) ;; RJP » 2019-01-16 (defun _dxf (c e) (cdr (assoc c (entget e)))) (cond ((and (setq e (car (entsel "\nPick source block: "))) (= "INSERT" (_dxf 0 e)) (setq s (ssget ":L" '((0 . "insert")))) ) (ssdel e s) (setq p (_dxf 10 e)) (setq e (vlax-ename->vla-object e)) (foreach b (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq o (vla-copy e)) (vlax-invoke o 'move p (_dxf 10 b)) ;; Pick what properties you want to match (setq o2 (vlax-ename->vla-object b)) (vla-put-rotation o (vla-get-rotation o2)) (vla-put-xscalefactor o (vla-get-xscalefactor o2)) (vla-put-yscalefactor o (vla-get-yscalefactor o2)) (vla-put-zscalefactor o (vla-get-zscalefactor o2)) (vla-put-layer o (vla-get-layer o2)) (vla-put-color o (vla-get-color o2)) (vla-put-linetype o (vla-get-linetype o2)) (vla-put-lineweight o (vla-get-lineweight o2)) (entdel b) ) ) ) (princ) )
    1 point
  6. Try the following code: (defun c:matchblock ( / att blk ent idx lst obj par sel vis ) (while (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect source block <exit>: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil) ( (/= "AcDbBlockReference" (vla-get-objectname (setq obj (vlax-ename->vla-object ent)))) (princ "\nThe selected object is not a block.") ) ( (= :vlax-false (vla-get-hasattributes obj) (vla-get-isdynamicblock obj)) (princ "\nThe selected block is neither attributed nor dynamic.") ) ) ) ) (if (and ent (setq sel (LM:ssget "\nSelect target blocks <exit>: " '("_:L" ((0 . "INSERT")))))) (progn (setq obj (vlax-ename->vla-object ent) att (LM:vl-getattributevalues obj) vis (LM:getvisibilitystate obj) ) (repeat (setq idx (sslength sel)) (setq idx (1- idx) obj (vlax-ename->vla-object (ssname sel idx)) ) (if att (LM:vl-setattributevalues obj att)) (if (and vis (= :vlax-true (vla-get-isdynamicblock obj)) (or (setq blk (strcase (LM:effectivename obj)) par (cdr (assoc blk lst)) ) (and (setq par (LM:getvisibilityparametername obj)) (setq lst (cons (cons blk par) lst)) ) ) ) (vl-some '(lambda ( prp ) (if (and (= par (vla-get-propertyname prp)) (member vis (vlax-get prp 'allowedvalues)) ) (vla-put-value prp (vlax-make-variant vis (vlax-variant-type (vla-get-value prp)))) ) ) (vlax-invoke obj 'getdynamicblockproperties) ) ) ) ) ) (princ) ) ;; Effective Block Name - Lee Mac ;; obj - [vla] VLA Block Reference object (defun LM:effectivename ( obj ) (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name ) ) ) ;; Get Attribute Values - Lee Mac ;; Returns an association list of attributes present in the supplied block. ;; blk - [vla] VLA Block Reference Object ;; Returns: [lst] Association list of ((<tag> . <value>) ... ) (defun LM:vl-getattributevalues ( blk ) (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) ;; Set Attribute Values - Lee Mac ;; Sets attributes with tags found in the association list to their associated values. ;; blk - [vla] VLA Block Reference Object ;; lst - [lst] Association list of ((<tag> . <value>) ... ) ;; Returns: nil (defun LM:vl-setattributevalues ( blk lst / itm ) (foreach att (vlax-invoke blk 'getattributes) (if (setq itm (assoc (vla-get-tagstring att) lst)) (vla-put-textstring att (cdr itm)) ) ) ) ;; Get Dynamic Block Visibility State - Lee Mac ;; Returns the value of the Visibility Parameter of a Dynamic Block (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; Returns: [str] Value of Visibility Parameter, else nil (defun LM:getvisibilitystate ( blk / vis ) (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) ;; Get Dynamic Block Property Value - Lee Mac ;; Returns the value of a Dynamic Block property (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; prp - [str] Dynamic Block property name (case-insensitive) (defun LM:getdynpropvalue ( blk prp ) (setq prp (strcase prp)) (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties) ) ) ;; Get Visibility Parameter Name - Lee Mac ;; Returns the name of the Visibility Parameter of a Dynamic Block (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; Returns: [str] Name of Visibility Parameter, else nil (defun LM:getvisibilityparametername ( blk / vis ) (if (and (vlax-property-available-p blk 'effectivename) (setq blk (vla-item (vla-get-blocks (vla-get-document blk)) (vla-get-effectivename blk) ) ) (= :vlax-true (vla-get-isdynamicblock blk)) (= :vlax-true (vla-get-hasextensiondictionary blk)) (setq vis (vl-some '(lambda ( pair ) (if (and (= 360 (car pair)) (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair))))) ) (cdr pair) ) ) (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary blk)) "ACAD_ENHANCEDBLOCK" ) ) ) ) (cdr (assoc 301 (entget vis))) ) ) ;; ssget - Lee Mac ;; A wrapper for the ssget function to permit the use of a custom selection prompt ;; msg - [str] selection prompt ;; arg - [lst] list of ssget arguments (defun LM:ssget ( msg arg / sel ) (princ msg) (setvar 'nomutt 1) (setq sel (vl-catch-all-apply 'ssget arg)) (setvar 'nomutt 0) (if (not (vl-catch-all-error-p sel)) sel) ) (vl-load-com) (princ)
    1 point
  7. Here's a quick one: (defun c:foo (/ _dxf e o p s) ;; RJP » 2019-01-15 (defun _dxf (c e) (cdr (assoc c (entget e)))) (cond ((and (setq e (car (entsel "\nPick source block: "))) (= "INSERT" (_dxf 0 e)) (setq s (ssget ":L" '((0 . "insert")))) ) (ssdel e s) (setq p (_dxf 10 e)) (setq e (vlax-ename->vla-object e)) (foreach b (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq o (vla-copy e)) (vlax-invoke o 'move p (_dxf 10 b)) (entdel b) ) ) ) (princ) )
    1 point
×
×
  • Create New...