Leaderboard

Hi, I have a dwg with a bunch of the same block in it (called Cabinet). This particular block has a number of visibility states. I have assigned an attribute (called SetVisState) to the block that I can modify via ATTOUT and ATTIN. I want a LISP routine to check this attribute in each block, then update it's visibility state based on this attribute. Unfortunately I have next to no experience with LISP, so any guidance would be appreciated. I have tried looking around this forum and others, but so far have only managed to run a LISP that checks the current visibility state and then toggles between states (I need it to check attribute value then change vis state accordingly). I tried Lee Macs code for getting attributes, but couldn't figure out how to apply that to my scenario either. Thanks in advance.

Here's another for fun .. works pretty well on geometry with many internal islands but doesn't do the self intersecting areas. (defun c:foo (/ a d e mp n o p p2 s x) ;; RJP » 2021-05-13 (setq d 0.075) (if (setq s (ssget "_X" '((0 . "LWPOLYLINE")))) (progn (setq s (mapcar 'cadr (ssnamex s))) (setq s (mapcar '(lambda (e) (list e (vlax-curve-getarea e))) s)) (setq s (mapcar 'car (vl-sort s '(lambda (r j) (< (cadr r) (cadr j)))))) (while (cadr s) (setq e (car s)) (setq s (cdr s)) (repeat (setq n (fix (vlax-curve-getendparam e))) (setq p (vlax-curve-getpointatparam e (- n 0.5))) (if (= 0 (vla-getbulge (vlax-ename->vla-object e) (fix (- n 0.5)))) (progn (setq a (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) e) ) s ) ) (setq a (vl-sort a '(lambda (r j) (< (cadr r) (cadr j))))) (cond ((< (cadar a) d) (grdraw (caar a) p 3) (setq o (vlax-ename->vla-object (last (car a)))) (setq mp (mapcar '/ (mapcar '+ (caar a) p) '(2 2 2))) (entmakex (list '(0 . "CIRCLE") (cons 10 mp) (cons 40 (/ (distance (caar a) p) 2)) '(62 . 3) ) ) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(8 . "DiameterText") '(100 . "AcDbText") '(62 . 1) (cons 10 mp) (cons 40 (/ (distance (caar a) p) 4)) (cons 1 (vl-string-right-trim "0" (strcat "%%C" (rtos (distance (caar a) p) 2 4))) ) '(50 . 0.) '(7 . "Standard") '(71 . 0) '(72 . 1) (cons 11 mp) '(100 . "AcDbText") '(73 . 2) ) ) ) ) ) ) (setq n (1- n)) ) ) ) ) ) (vl-load-com)

https://forums.autodesk.com/t5/autocad-forum/how-to-find-version-what-version-dxf-format-we-are-saving-the/m-p/2442367#M334861 Open the DXF file in Notepad and look at the 2nd line under $ACADVER at the top of the file If R12 DXF then it = AC1009 If 2000 DXF then it = AC1015 If 2004 DXF then it = AC1018 If 2007 DXF then it = AC1021 You can also do the same test with a DWG file to see its version.

Glad you got it sorted.

Well, I found the problem... AutoCAD Architecture 2020 had a problem activating Active-X. I found a regestry hack and finaly I works! Yee-Haw! Thanks for your patience and your help!

(vl-sort lst '(lambda (x y) (< (car x) (car y))))

I made something. See if it can be useful to you. - It will copy "Layout1" multiple times, and name them "Paper1", "Paper2", ... So prepare the pagesetup of Layout1. Remove the viewport (new viewports will be created), but you can add a cartouche (or whatever you need there) Command ALS (for Automatic Layout Setup) - user set the length, height and overlap (for example 800 500 50). - user selects a polyline. -> Along the polyline rectangles (polylines) are created. -> Paper spaces are created, each with a viewport the same size as the rectangles. -> Each viewport pans/zooms (scale is set to 1.00) to a next rectangle Try it on my dwg first (vl-load-com) ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun LWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;; based on @see http://www.lee-mac.com/totallengthandarea.html (defun totalLengthPolyline ( s / i) (setq l 0.0) (repeat (setq i (sslength s)) (setq e (ssname s (setq i (1- i))) l (+ l (vlax-curve-getdistatparam e (vlax-curve-getendparam e))) ) ) l ) ;;;;;;;;;;;;;;;;;;;;;; (defun vat (viewport_length viewport_height overlap / obj pline total_length needle mp1 mp2 ang1 rec1 rec2 rec3 rec4) ;; settings ;;(setq viewport_length 700.0) ;;(setq viewport_height 400.0) ;;(setq overlap 50.0) ;; (princ "\nSelect Polytine") (setq pline (ssget (list (cons 0 "LWPOLYLINE,POLYLINE")) )) (setq obj (vlax-ename->vla-object (ssname pline 0))) (princ (setq total_length (totalLengthPolyline pline)) ) (setq needle 0.0) (while (< needle total_length) ;; (+ total_length viewport_length) (setq mp1 (vlax-curve-getPointAtDist obj needle)) (setq needle (+ needle viewport_length)) (setq mp2 (vlax-curve-getPointAtDist obj needle)) ;; last point, take the end of the polyline (if (= mp2 nil) (setq mp2 (vlax-curve-getPointAtDist obj total_length)) ) (setq ang1 (angle mp1 mp2)) (setq rec1 (polar mp2 (+ ang1 (/ pi 2)) (/ viewport_height 2))) (setq rec2 (polar rec1 (+ ang1 pi) viewport_length)) (setq rec3 (polar rec2 (+ ang1 (* pi 1.5)) viewport_height)) (setq rec4 (polar rec3 ang1 viewport_length)) ;; fill in the globals (setq LWPolylines_data (append LWPolylines_data (list (list rec1 rec2 rec3 rec4) ))) (setq LWPolylines (append LWPolylines (list (LWPoly (list rec1 rec2 rec3 rec4) 1) ))) (setq pointpairs (append pointpairs (list (list mp1 mp2) ))) (setq needle (- needle overlap)) ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; c:copying-lay-out ;; It will name the layouts "Paper1", "Paper2", ... (defun clo (pointpairs / i n layoutname ) (if (and (setq layoutname "Layout1") (setq n (length pointpairs)) ;; number of new layouts (setq i (+ n 1)) (member layoutname (layoutlist)) ) (repeat n (command "layout" "Copy" layoutname (strcat "Paper" (rtos (setq i (- i 1)))) ) );; repeat );; if (princ) );; demo (defun AlignView (p1 p2 / ang) ;;(command "ucs" "world" "\\") (and ;;(setq p1 (getpoint "\nFirst alignment point: ")) ;;(setq p2 (getpoint p1 "\nSecond alignment point: ")) (setq ang (- (angle (trans p1 1 0) (trans p2 1 0)))) (command "_.dview" "" "_twist" (angtos ang (getvar 'aunits) 16) "") ) (command "ucs" "view" "\\") (princ) ) ;; rotate view (defun rv (1point 2point / ) (command "_ucs" "_w") (if (and 1point 2point) (progn (command "_zoom" "_c" 1point "") (if (= (getvar "angdir") 0) (command "_dview" "" "_tw" (angtos (+ (* -1 (angle 1point 2point)) (getvar "angbase"))(getvar "aunits") 10) "") (command "_dview" "" "_tw" (angtos (+ (angle 1point 2point) (getvar "angbase")) (getvar "aunits") 10) "") ) (setvar "snapang" (angle 1point 2point)) );progn (progn (command "_dview" "" "_tw" "0" "") (setvar "snapang" 0.0) );progn ) (command "_ucs" "_w") (princ) );end defun ;; globals (setq pointpairs (list)) (setq LWPolylines (list)) (setq LWPolylines_data (list)) (defun ALS (viewport_length viewport_height overlap / i pair pt1 pt2) ;; settings ;;(setq viewport_length 800.0) ;;(setq viewport_height 500.0) ;;(setq overlap 50.0) ;; (re) initiate globals (setq LWPolylines (list)) (setq LWPolylines_data (list)) (setq pointpairs (list)) (vat viewport_length viewport_height overlap) (clo pointpairs) (princ LWPolylines_data) (setq i 0) (foreach pair pointpairs (setvar "ctab" (strcat "Paper" (itoa (+ i 1) ))) ;; This example creates a paper space viewport and makes it active. (setq acadObj (vlax-get-acad-object)) (setq doc (vla-get-ActiveDocument acadObj)) (setq centerPoint (vlax-3d-point (/ viewport_length 2.0) (/ viewport_height 2.0) 0) height viewport_height width viewport_length) ;; Create a paper space Viewport object (vla-put-ActiveSpace doc acPaperSpace) (setq newPViewport (vla-AddPViewport (vla-get-PaperSpace doc) centerPoint width height)) (vla-ZoomAll acadObj) (vla-Display newPViewport :vlax-true) ;; Before making a pViewport active, ;; the mspace property needs to be True (vla-put-MSpace doc :vlax-true) (vla-put-ActivePViewport doc newPViewport) (rv (nth 0 pair) (nth 1 pair)) ;; pt1 pt2 ;zoom window (setq pt1 (nth 2 (nth i LWPolylines_data))) (setq pt2 (nth 0 (nth i LWPolylines_data))) (command "zoom" "_o" (nth i LWPolylines) "") (vla-put-MSpace doc :vlax-false) (vla-put-customscale newPViewport 1.0) ;;(command "_.PSPACE") ;;(command "ucs" "world" "\\") (setq i (+ i 1)) ) ) ;; Automatic layout setup (defun c:ALS2 ( / viewport_length viewport_height overlap ) ;; settings (setq viewport_length 800.0) (setq viewport_height 500.0) (setq overlap 50.0) (ALS viewport_length viewport_height overlap ) ) ;; Automatic layout setup (defun c:ALS ( / ) (ALS (getreal "\nViewport length: ") (getreal "\nViewport height: ") (getreal "\noverlap: ") ) ) viewports_along_track.dwg

Hi, Sorry for hijacking an old thread, I would like to achieve the same as the OP. I have copied the code and changed all instances of the OP's block reference (Cabinet) so it calls for my block (Revision Table) however it doesn't work. When I then rename my block to be called cabinet it works perfectly. So I am clearly missing something, would someone be able to assist with this please as its driving me mad. Thanks!

Lee, I checked through everything again and it turns out I had actually named the block "Cabient" Thanks so much for your help - it works perfectly.

Thanks Lee. I am still getting nothing. I have copied the following code from your reply above, and the subfunctions from the links you provided above, into a single .LSP file named "Test.LSP". I've dragged and dropped this into the dwg. I then type "Test" in the command line. All that shows up in the command line once is as follows: Command: (LOAD "C:/Users/.../Desktop/Data Extract/Test.LSP") LM:SETVISIBILITYSTATE Command: TEST (defun c:test ( / i o s ) (if (setq s (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "`*U*,Cabinet")))) (repeat (setq i (sslength s)) (setq o (vlax-ename->vla-object (ssname s (setq i (1- i))))) (if (and (vlax-property-available-p o 'effectivename) (= "cabinet" (strcase (vla-get-effectivename o) t)) ) (progn (princ (strcat "\nFound cabinet block \"" (vla-get-handle o) "\".")) (if (setq v (LM:vl-getattributevalue o "SetVisState")) (progn (princ (strcat "\nValue of \"SetVisState\" attribute = " v)) (if (LM:setvisibilitystate o v) (princ (strcat "\nVisibility state set to \"" v "\".")) (princ (strcat "\nUnable to set visibility state to \"" v "\".")) ) ) (princ "\n\"SetVisState\" attribute not found in Cabinet block.") ) ) ) ) (princ "\nNo attributed 'Cabinet' blocks found in the drawing.") ) (princ) ) (vl-load-com) (princ) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue ( blk tag ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes) ) ) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:vl-setattributevalue ( blk tag val ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val) ) ) (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 Attributes - 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-getattributes ( blk ) (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes) ) ) ;; 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) ) ) ;; Set Dynamic Block Property Value - Lee Mac ;; Modifies the value of a Dynamic Block property (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; prp - [str] Dynamic Block property name (case-insensitive) ;; val - [any] New value for property ;; Returns: [any] New value if successful, else nil (defun LM:setdynpropvalue ( blk prp val ) (setq prp (strcase prp)) (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (progn (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x)))) (cond (val) (t)) ) ) ) (vlax-invoke blk 'getdynamicblockproperties) ) ) ;; Get Dynamic Block Properties - Lee Mac ;; Returns an association list of Dynamic Block properties & values. ;; blk - [vla] VLA Dynamic Block Reference object ;; Returns: [lst] Association list of ((<prop> . <value>) ... ) (defun LM:getdynprops ( blk ) (mapcar '(lambda ( x ) (cons (vla-get-propertyname x) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties) ) ) ;; Set Dynamic Block Properties - Lee Mac ;; Modifies values of Dynamic Block properties using a supplied association list. ;; blk - [vla] VLA Dynamic Block Reference object ;; lst - [lst] Association list of ((<Property> . <Value>) ... ) ;; Returns: nil (defun LM:setdynprops ( blk lst / itm ) (setq lst (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) lst)) (foreach x (vlax-invoke blk 'getdynamicblockproperties) (if (setq itm (assoc (strcase (vla-get-propertyname x)) lst)) (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x)))) ) ) ) ;; Get Dynamic Block Property Allowed Values - Lee Mac ;; Returns the allowed values for a specific Dynamic Block property. ;; blk - [vla] VLA Dynamic Block Reference object ;; prp - [str] Dynamic Block property name (case-insensitive) ;; Returns: [lst] List of allowed values for property, else nil if no restrictions (defun LM:getdynpropallowedvalues ( blk prp ) (setq prp (strcase prp)) (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'allowedvalues))) (vlax-invoke blk 'getdynamicblockproperties) ) ) ;; Toggle Dynamic Block Flip State - Lee Mac ;; Toggles the Flip parameter if present in a supplied Dynamic Block. ;; blk - [vla] VLA Dynamic Block Reference object ;; Return: [int] New Flip Parameter value (defun LM:toggleflipstate ( blk ) (vl-some '(lambda ( prp / rtn ) (if (equal '(0 1) (vlax-get prp 'allowedvalues)) (progn (vla-put-value prp (vlax-make-variant (setq rtn (- 1 (vlax-get prp 'value))) vlax-vbinteger)) rtn ) ) ) (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))) ) ) ;; 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 ) (LM:getdynpropvalue blk (LM:getvisibilityparametername blk)) ) ;; Set Dynamic Block Visibility State - Lee Mac ;; Sets the Visibility Parameter of a Dynamic Block (if present) to a specific value (if allowed) ;; blk - [vla] VLA Dynamic Block Reference object ;; val - [str] Visibility State Parameter value ;; Returns: [str] New value of Visibility Parameter, else nil (defun LM:SetVisibilityState ( blk val / vis ) (if (and (setq vis (LM:getvisibilityparametername blk)) (member (strcase val) (mapcar 'strcase (LM:getdynpropallowedvalues blk vis))) ) (LM:setdynpropvalue blk vis val) ) )

No problem - the following updated code will print a number of messages to the command-line to let you know what's going on: (defun c:test ( / i o s ) (if (setq s (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "`*U*,Cabinet")))) (repeat (setq i (sslength s)) (setq o (vlax-ename->vla-object (ssname s (setq i (1- i))))) (if (and (vlax-property-available-p o 'effectivename) (= "cabinet" (strcase (vla-get-effectivename o) t)) ) (progn (princ (strcat "\nFound cabinet block \"" (vla-get-handle o) "\".")) (if (setq v (LM:vl-getattributevalue o "SetVisState")) (progn (princ (strcat "\nValue of \"SetVisState\" attribute = " v)) (if (LM:setvisibilitystate o v) (princ (strcat "\nVisibility state set to \"" v "\".")) (princ (strcat "\nUnable to set visibility state to \"" v "\".")) ) ) (princ "\n\"SetVisState\" attribute not found in Cabinet block.") ) ) ) ) (princ "\nNo attributed 'Cabinet' blocks found in the drawing.") ) (princ) ) (vl-load-com) (princ)

Thanks for the responses. Lee, I haven't been able to get that code to work yet. I copied the code above into a text file and renamed it Test.LSP. I then copied all of the subfunctions from the two links you provided beneath the provided code in the Test.LSP file. I dragged and dropped this file into the dwg. I typed Test in the command line. Literally nothing happens haha. Am I doing something obviously wrong? Or should I start learning how to debug LISP haha. Thanks again for your help.

Consider the following example: (defun c:test ( / i o s ) (if (setq s (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "`*U*,Cabinet")))) (repeat (setq i (sslength s)) (setq o (vlax-ename->vla-object (ssname s (setq i (1- i))))) (if (and (vlax-property-available-p o 'effectivename) (= "cabinet" (strcase (vla-get-effectivename o) t)) ) (if (setq v (LM:vl-getattributevalue o "SetVisState")) (LM:setvisibilitystate o v) ) ) ) ) (princ) ) (vl-load-com) (princ) You will need to first download & load the required attribute & dynamic block functions from my site. @iconeo, thank you for the recommendation

Lee Mac has some helper functions on his website for manipulating the visibility states of blocks.