I'm trying to get the last modified date from a list of files for a sort option. I have found a source, here, where someone can update when a file was last modified, but I'm having trouble reversing the process. I keep receiving Error: Missing parameter for function. message when I try to use vlax-get and vlax-get-property.
(vl-load-com)
;; Original code
(defun SetFileLastModified ( file date / i fso fObj sh
oFolder oFiles iCount fItem filepath
vTemp)
(setq fso (vlax-create-object "Scripting.FileSystemObject"))
(if (= (vlax-invoke fso 'FileExists file) :vlax-true)
(progn ;; True
(setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
(setq oFolder (vlax-invoke sh 'NameSpace (vl-filename-directory file)))
(setq oFiles (vlax-invoke oFolder 'Items))
(setq iCount (vlax-get oFiles 'Count))
(setq i 0)
(while (< i iCount)
(setq fItem (vlax-invoke oFiles 'Item i))
(setq filepath (vlax-get fItem 'path))
(if (= (vl-filename-base filepath) (vl-filename-base file))(progn
(vlax-put fItem 'ModifyDate date);<-- Command to update the last modified date.
));if
(setq i (1+ i))
);while
(vlax-release-object sh)
);progn ; True
(print (strcat "File not found: " file)); False
);if
(vlax-release-object fso)
);PullLastModified
;; Failed attempt
(defun PullLastModified ( file / i fso fObj sh
oFolder oFiles iCount fItem filepath
vTemp)
(setq fso (vlax-create-object "Scripting.FileSystemObject"))
(if (= (vlax-invoke fso 'FileExists file) :vlax-true)
(progn ;; True
(setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
(setq oFolder (vlax-invoke sh 'NameSpace (vl-filename-directory file)))
(setq oFiles (vlax-invoke oFolder 'Items))
(setq iCount (vlax-get oFiles 'Count))
(setq i 0)
(while (< i iCount)
(setq fItem (vlax-invoke oFiles 'Item i))
(setq filepath (vlax-get fItem 'path))
(if (= (vl-filename-base filepath) (vl-filename-base file))(progn
(princ "\nTest-01\n")
(setq vTemp (vlax-get fItem 'ModifyDate));<-- Having trouble pulling the modified date.
(princ "\nModified Date : ")(prin1 vTemp)(terpri)
));if
(setq i (1+ i))
);while
(vlax-release-object sh)
);progn ; True
(print (strcat "File not found: " file)); False
)
(vlax-release-object fso)
);PullLastModified
Update
Found the reason why I cannot use 'DateLastModified to pull the latest modification date. Alternatives?
That code appears to be performing many unnecessary operations when obtaining the file object: rather than using the Namespace property of the Shell object to obtain the folder and then iterating over the contents of the folder until arriving at a file with the target filename, you can obtain the file object directly using the getfile method of the File System Object (FSO).
Consider the following code:
(defun LM:filelastmodified ( fnm / fob fso rtn )
(cond
( (not (setq fnm (findfile fnm))))
( (setq fso (vlax-get-or-create-object "scripting.filesystemobject"))
(setq fob (vlax-invoke-method fso 'getfile fnm)
rtn (+ 2415019 (vlax-get fob 'datelastmodified))
)
(vlax-release-object fob)
(vlax-release-object fso)
)
)
rtn
)
The above function will return a Julian datetime representing the last modified date of the file - you can then use the edtime DIESEL function within a menucmd expression to output this as a readable datetime, e.g.:
(defun c:test ( / fnm mod )
(cond
( (not (setq fnm (getfiled "Select File" "" "" 16)))
(princ "\n*Cancel*")
)
( (not (setq mod (LM:filelastmodified fnm)))
(princ "\nUnable to obtain last modified date.")
)
( (princ (strcat "\nLast modified: " (menucmd (strcat "m=$(edtime," (rtos mod 2 15) ",yyyy-mo-dd hh:mm:ss)")))))
)
(princ)
)
Related
I have to write the function that determines the number and values of block attributes in AutoLisp.
I have function which count the atributes:
(defun c:Test (/ s ss)
(if (and (princ "\n Select FIRST Attributed Block :")
(setq s (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
(princ "\n Select the SECOND Attributed Block :")
(setq ss (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
)
(mapcar
'length
(mapcar
'(lambda (a)
(mapcar
'(lambda (x) (vla-get-textstring x))
(vlax-invoke (vlax-ename->vla-object a) 'getattributes)
)
)
(list (ssname s 0) (ssname ss 0))
)
)
)
)**
A function that returns the values of attributes:
(defun c:Test (/ ss n e x)
(while (progn (princ "\n Select single attributed block :")
(setq ss (ssget "_+.:S" '((0 . "INSERT") (66 . 1))))
)
(setq n (entnext (ssname ss 0)))
(while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND" ))
(if (eq (cdr (assoc 0 e)) "ATTRIB")
(print (cdr (assoc 1 e)))
)
(setq n (entnext n))
)
)
(princ)
)
Could you help me to combine this to functions into one?
Here is a lisp program that will loop over all blocks from a user selection set and:
1.) print block name
2.) print the association list of AttributeTag.AttributeValue
3.) print the list of AttributeTags
4.) print the list of AttributeValues
5.) print the number of AttributeValues
I also attached what the command line output should look like.
Lisp command line output
;;www.cadwiki.net
(defun c:test (/ SSINPUT)
(setq ssInput (ssget (list '(0 . "insert"))))
(PRINT-BLOCK-ATTRIBUTE-INFO ssInput)
(princ)
)
(defun PRINT-BLOCK-ATTRIBUTE-INFO (ssInput / ATTRIBUTETAGS ATTRIBUTETAGSTOVALUES ATTRIBUTEVALUES BLOCKENTITY BLOCKVLAOBJECT I NUMBEROFBLOCKATTRIBUTES
)
(setq i 0)
(if (= ssInput nil)
(progn
(princ "ssInput was nothing, exiting.")
(exit)
)
)
(princ (strcat "\nItems in selection set: " (itoa (sslength ssInput))))
(while (< i (sslength ssInput))
(setq blockEntity (ssname ssInput i))
(setq blockVlaObject (vlax-ename->vla-object blockEntity))
(setq attributeTagsToValues (GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC blockEntity))
(princ (strcat "\nBlock name: " (vla-get-name blockVlaObject)))
(princ "\nBlock attributes tag to values association list: ")
(princ attributeTagsToValues)
(setq attributeTags (GET-NTHS-FROM-LISTS 0 attributeTagsToValues nil))
(princ "\nBlock attribute tags list: ")
(princ attributeTags)
(setq attributeValues (GET-LAST-ITEM-FROM-EACH-LIST attributeTagsToValues))
(princ "\nBlock attributes values list: ")
(princ attributeValues)
(princ "\nNumber of block attributes: ")
(setq numberOfBlockAttributes (itoa (length attributeValues)))
(princ numberOfBlockAttributes)
(setq i (+ i 1))
)
)
(defun GET-NTHS-FROM-LISTS (N LSTs removeDuplicates / CT LST2 LST IT)
(setq LST2 nil)
(foreach LST LSTs
(setq IT (nth N LST))
(if removeDuplicates
(if (not (member IT LST2))
(setq LST2 (append LST2 (list IT)))
)
(setq LST2 (append LST2 (list IT)))
)
)
LST2
)
(defun GET-LAST-ITEM-FROM-EACH-LIST (LSTs / CDRs FAIL LST)
(setq CDRs nil
FAIL nil
)
(if (not (= (type LSTs) 'LIST))
(setq FAIL "not a list")
)
(if (not FAIL)
(foreach LST LSTs
(setq FAIL (cond
((not (= (type LST) 'LIST)) "non-list member")
((not (cdr LST)) "no CDR")
(T nil)
)
)
(if (not FAIL)
(setq CDRs (append CDRs (list (cdr LST))))
)
)
)
CDRs
)
(defun GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC (entity / COUNTER COUNTER2 COUNTERMAX COUNTERMAX2 DXFCODE0 DXFCODE2 DXFCODE66 DXFCODE8 DXFCODECODE-1 ENTITIESTORETURN ENTITYDXFCODES *ERROR* RETURNLIST
SUPPLIEDTRUENAME TRUENAME ATTRIBUTETAG ATTRIBUTEVALUE DXFCODE-1 ENTITYNAMEFORDRILLING SUBLIST TAGSANDVALUES THECALLINGFUNCTIONSNAME
)
(setq counter 0) ;initialize counter to 0 for while loop
(if ;if
(/= entity nil) ;entity is not nil
(progn ;progn wrap
(setq entityDxfCodes (entget entity)) ;set the varaible entityDxfCodes to the list of entities from the en varaible
;; you can use the method here to find any value from a dxfCodecode
(setq dxfCode-1 (cdr (assoc -1 entityDxfCodes))) ;set dxfCode-1 to the second element of the item that has -1 as it's first element, this is the entity name
(setq dxfCode0 (cdr (assoc 0 entityDxfCodes))) ;set dxfCode0 to the element of the item that has 0 as it's first element, this is the entity type
(setq dxfCode2 (cdr (assoc 2 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the name, or block name
(setq dxfCode8 (cdr (assoc 8 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the layer
(setq dxfCode66 (cdr (assoc 66 entityDxfCodes))) ;set dxfCode66 to the second element of the item that has 66 as it's first element, this is the attribute flag
(setq entityNameForDrilling entity)
(if ;if start
(= dxfCode66 1) ;entity attribute flag is 1
(progn ;progn wrap
(while (/= dxfCode0 "SEQEND") ;while loop to drill to each sub entity in a block
(setq attributeTag (cdr (assoc 2 entityDxfCodes))) ;set attributeTag to the second element of the second Dxf code (assoc 2) of the entityDxfCodes variable
(setq attributeValue (cdr (assoc 1 entityDxfCodes))) ;set attributeValue to the second element of the first Dxf code (assoc 1) of the entityDxfCodes variable
(if
(/= attributeValue nil)
(progn
(setq sublist (cons attributeTag attributeValue))
(setq tagsAndValues (cons sublist TagsAndValues))
)
)
(setq entityNameForDrilling (entnext entityNameForDrilling))
(setq entityDxfCodes (entget entityNameForDrilling))
(setq dxfCode0 (cdr (assoc 0 entityDxfCodes)))
)
) ;progn wrap end
) ;if end
) ;progn wrap end
) ;if end
(setq returnList tagsAndValues)
)
I'm trying to create an array of lists with its elements being: Surname , Name and Age.
Here is my code in AutoLISP:
(defun C:DP_ADINREG ( / prenume nume varsta inreg)
(initget 1)
(setq prenume (getstring "\nIntroduceti prenumele: "))
(initget 1)
(setq nume (getstring "\nIntroduceti numele: "))
(initget 7)
(setq varsta (getint "\nIntroduceti varsta: "))
(setq inreg (list (cons 'pn prenume) (cons 'nf nume)
(cons 'v varsta))
DP_DATA (append DP_DATA (list inreg))
)
(princ)
)
(defun C:DP_LISTARE ( / curent inreg n)
(setq curent DP_DATA
n 1)
(while curent
(setq inreg (car curent))
(princ (strcat "\nInregistrarea #" (itoa n)
": " (cdr (assoc 'pn inreg))
", " (cdr (assoc 'nf inreg))
". Varsta " (itoa (cdr (assoc 'v inreg)))
)
)
(setq curent (cdr curent)
n (1+ n)
)
)
(princ)
)
Problem is, when trying to access the second function, it gives me an error called:
Bad argument type : fixnump : nil.
Now I have no idea where the problem actually is.
Any ideas?
The error:
; error: bad argument type: fixnump: nil
Arises when a function requiring an integer argument is supplied with a value of nil. Hence, this error is arising from the evaluation of the second of your two itoa expressions:
(itoa (cdr (assoc 'v inreg)))
(Since the first itoa expression is being supplied with the variable n, which cannot be nil).
This implies that the following expression returns nil:
(cdr (assoc 'v inreg))
Which implies that one of the association lists within the list held by your global variable DP_DATA does not contain a dotted pair with key v. I would therefore suggest checking the value held by your global variable DP_DATA.
Aside: note that initget has no effect on a getstring prompt - you can achieve the same effect using a basic while loop, e.g.:
(while (= "" (setq prenume (getstring "\nIntroduceti prenumele: ")))
(princ "\nPlease enter a first name.")
)
(while (= "" (setq nume (getstring "\nIntroduceti numele: ")))
(princ "\nPlease enter a surname.")
)
You can account for null values in your association list using some basic error checking:
(defun C:DP_ADINREG ( / prenume nume varsta )
(while (= "" (setq prenume (getstring "\nIntroduceti prenumele: ")))
(princ "\nPlease enter a first name.")
)
(while (= "" (setq nume (getstring "\nIntroduceti numele: ")))
(princ "\nPlease enter a surname.")
)
(initget 7)
(setq varsta (getint "\nIntroduceti varsta: ")
DP_DATA (cons (list (cons 'pn prenume) (cons 'nf nume) (cons 'v varsta)) DP_DATA)
)
(princ)
)
(defun C:DP_LISTARE ( / n )
(setq n 0)
(foreach lst (reverse DP_DATA)
(princ
(strcat
"\nInregistrarea #" (itoa (setq n (1+ n)))
": " (cond ((cdr (assoc 'pn lst))) (""))
", " (cond ((cdr (assoc 'nf lst))) (""))
". Varsta " (itoa (cond ((cdr (assoc 'v lst))) (0)))
)
)
)
(princ)
)
The above will return a blank first name/surname where not present, and an age of 0 where not present; you could alternatively return an error if these values are not present, e.g.:
(defun C:DP_LISTARE ( / n nf pn v )
(setq n 1)
(foreach lst (reverse DP_DATA)
(if
(and
(setq pn (cdr (assoc 'pn lst)))
(setq nf (cdr (assoc 'nf lst)))
(setq v (cdr (assoc 'v lst)))
)
(princ (strcat "\nInregistrarea #" (itoa n) ": " pn ", " nf ". Varsta " (itoa v)))
(princ (strcat "\nMissing data for item " (itoa n)))
)
(setq n (1+ n))
)
(princ)
)
I'm trying to insert blocks with custom properties. How do I set those variables?
Within the Deciduous block there is a custom property called "visibility" with various different styles (Visibility 1, Visibility 2, Visibility 3, ...).
For instance, how would I insert the Deciduous block with Visibility 3.
(DEFUN C:TREE ( / DECIDUOUS CONIFER SHRUBMEDIUM SHRUBSMALL)
(INITGET 1 "DECIDUOUS CONIFER SHRUBMEDIUM SHRUBSMALL")
(OR
(SETQ RETKWORD (GETKWORD "\nSpecify tree type: [DECIDUOUS/CONIFER/SHRUBMEDIUM/SHRUBSMALL]:"))
(SETQ RETKWORD "DECIDUOUS")
)
(IF (= RETKWORD "DECIDUOUS")
(PROGN
(SETQ OLDLAYER (GETVAR "CLAYER"))
(SETQ FLAG (TBLSEARCH "LAYER" "L-PLNT-DECD"))
(IF FLAG
(SETVAR "CLAYER" "L-PLNT-DECD")
)
(INITGET 1 "Visibility1 Visibility2 Visibility3")
(OR
(SETQ CMDKWORD (GETKWORD "\nPick a command: [Visibility1/Visibility2/Visibility3]:"))
)
(IF (= CMDKWORD "Visibility3")
(PROGN
(COMMAND "INSERT"
"TT-L-TREE-DECIDUOUS"
)
)
)
(PRINC)
)
)
)
The answer to this question ultimately depends on whether or not you require the visual preview of the inserted block reference, as afforded by the AutoCAD INSERT command.
Since the standard AutoCAD INSERT command does not prompt for dynamic block parameter values during block insertion, you'll need to insert the block and then manipulate the visibility state using the ActiveX properties & methods of the inserted dynamic block reference, specifically, using the getdynamicblockproperties method.
If the visual preview of the inserted block is NOT required...
...then you can forego the INSERT command entirely, and use the insertblock method of the target container object (modelspace/paperspace/block definition), which will return a block reference vla-object.
Here is a basic example demonstrating how to use the insertblock method:
(defun c:test ( / dwg ins )
(if
(and
(setq dwg (getfiled "Select Block" "" "dwg" 16))
(setq ins (getpoint "\nSpecify insertion point: "))
)
(vla-insertblock
(vlax-get-property
(vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
(vlax-3D-point (trans ins 1 0))
dwg
1.0 1.0 1.0 0.0
)
)
(princ)
)
(vl-load-com) (princ)
This method will return a block reference vla-object, whose dynamic block properties you can then manipulate using the array of dynamic block properties returned by the getdynamicblockproperties method.
Since you are looking to modify the Visibility State in particular, you may wish to consider the following set of functions that I have developed as part of my dynamic block library to modify the visibility state of a supplied block reference object:
;; 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)
)
)
;; 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 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)
)
)
;; 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)
)
)
You might call the above functions from the earlier example I provided in the following way (changing the name of the visibility state to suit your block of course):
(defun c:test ( / dwg ins )
(if
(and
(setq dwg (getfiled "Select Block" "" "dwg" 16))
(setq ins (getpoint "\nSpecify insertion point: "))
)
(LM:SetVisibilityState
(vla-insertblock
(vlax-get-property
(vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
(vlax-3D-point (trans ins 1 0))
dwg
1.0 1.0 1.0 0.0
)
"YourVisibilityState"
)
)
(princ)
)
(vl-load-com) (princ)
If the visual preview of the inserted block IS required...
...Then aside from rolling your own version of the standard INSERT command using a grread loop (which would also need to imitate all drawing aids, such as Object Snap, and Orthomode), you would need to make use of the INSERT command.
However, since the visibility state of the block can only be changed following the insertion of the block reference, the visual preview displayed to the user will be inaccurate.
To get the best of both worlds, I have previously proposed the following possible solution (along with an accompanying function posted here):
;; Example demonstrating a method to insert a Dynamic Block with a Visibility State already set.
;; Lee Mac - 2013-12-24
(defun c:test ( / *error* att blk def doc ent new obj par spc tmp vis )
(defun *error* ( msg )
(if (= 'int (type att))
(setvar 'attreq att)
)
(foreach obj (list new def)
(if (and (= 'vla-object (type obj)) (not (vlax-erased-p obj)))
(vl-catch-all-apply 'vla-delete (list obj))
)
)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(cond
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
(princ "\nCurrent layer locked.")
)
( (null (setq blk (getfiled "Select Dynamic Block with Visibility States" "" "dwg" 16)))
(princ "\n*Cancel*")
)
( (progn
(setq doc (vla-get-activedocument (vlax-get-acad-object))
spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
obj (vlax-invoke spc 'insertblock '(0.0 0.0 0.0) blk 1.0 1.0 1.0 0.0)
)
(vla-put-visible obj :vlax-false)
(= :vlax-false (vla-get-isdynamicblock obj))
)
(princ "\nSelected block is not dynamic.")
(vla-delete obj)
)
( (null (setq par (LM:getvisibilityparametername obj)))
(princ "\nSelected block does not have a visibility parameter.")
(vla-delete obj)
)
( (null (setq vis (car (LM:listbox "Choose a Visibility State" (acad_strlsort (LM:getdynpropallowedvalues obj par)) 0))))
(princ "\n*Cancel*")
(vla-delete obj)
)
( t
(LM:setdynpropvalue obj par vis)
(setq tmp 0)
(while (tblsearch "block" (setq blk (strcat "tmp" (itoa (setq tmp (1+ tmp)))))))
(vla-put-visible
(car
(vlax-invoke doc
'copyobjects
(list obj)
(setq def (vlax-invoke (vla-get-blocks doc) 'add '(0.0 0.0 0.0) blk))
)
)
:vlax-true
)
(vla-delete obj)
(setq ent (entlast)
att (getvar 'attreq)
)
(setvar 'attreq 0)
(if
(and
(vl-cmdf "_.-insert" blk "_S" 1.0 "_R" 0.0 "\\")
(not (eq ent (setq ent (entlast))))
(= "AcDbBlockReference" (vla-get-objectname (setq new (vlax-ename->vla-object ent))))
)
(progn
(vla-explode new)
(vla-delete new)
)
)
(vl-catch-all-apply 'vla-delete (list def))
)
)
(princ)
)
;; 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 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)
)
)
;; 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)
)
)
;; List Box - Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
(defun LM:listbox ( msg lst bit / dch des tmp rtn )
(cond
( (not
(and
(setq tmp (vl-filename-mktemp nil nil ".dcl"))
(setq des (open tmp "w"))
(write-line
(strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
(if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
)
des
)
(not (close des))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch)
)
)
(prompt "\nError Loading List Box Dialog.")
)
( t
(start_list "list")
(foreach itm lst (add_list itm))
(end_list)
(setq rtn (set_tile "list" "0"))
(action_tile "list" "(setq rtn $value)")
(setq rtn
(if (= 1 (start_dialog))
(if (= 2 (logand 2 bit))
(read (strcat "(" rtn ")"))
(mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
)
)
)
)
)
(if (< 0 dch)
(unload_dialog dch)
)
(if (and tmp (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
rtn
)
(vl-load-com) (princ)
My solution essentially involves temporarily inserting a block reference, configuring the visibility state appropriately, creating a temporary block definition containing the configured dynamic block, and then exploiting the visual preview offered by the standard INSERT command to insert the temporary block reference, which is then exploded & purged from the drawing.
Blocks with custom properties are called Dynamic blocks.
Details and samples You can find here
p.s.
Thank You #LeeMac
I have my project files set in this format:
/home/user/proj/source
/home/user/proj/source/src1
/home/user/proj/source/src1
/home/user/proj/header ...etc
I have a way to find the project path when viewing any source file
"/home/user/proj"
Also, (buffer-file-name) gives the full absolute path of a given source file.
How to write a lisp function that extract the relative path of a source file?
Meaning, if I am viewing
/home/user/proj/source/src1/file.c
I would like to have the path
"source/src1/file.c"
The following function gives me the project path:
(defun upward-find-file (filename &optional startdir)
(let ((dirname (expand-file-name
(if startdir startdir ".")))
(found nil) ; found is set as a flag to leave loop if we find it
(top nil)) ; top is set when we get
; to / so that we only check it once
; While we've neither been at the top last time nor have we found
; the file.
(while (not (or found top))
; If we're at / set top flag.
(if (string= (expand-file-name dirname) "/")
(setq top t))
; Check for the file
(if (file-exists-p (expand-file-name filename dirname))
(setq found t)
; If not, move up a directory
(setq dirname (expand-file-name ".." dirname))))
; return statement
(if found (concat dirname "/") nil)))
I always have "Makefile" in the main project folder, so
(setq dirname (upward-find-file "Makefile" startdir))
Takes care of that.
Try locate-dominating-file and file-relative-name.
(let ((fname (buffer-file-name)))
(file-relative-name fname (locate-dominating-file fname "Makefile")))
N.B. locate-dominiating-file returns nil if it can't find anything.
How about this:
(defun file-name-make-relative (filename reference)
(interactive)
(let ((reduced-path-reference)
(common-pos 0)
(depth 0)
(pos 0)
(retval ""))
(while (eq (aref filename common-pos) (aref reference common-pos))
(setq common-pos (+ common-pos 1)))
(setq reduced-path-reference (substring reference (+ common-pos 1)))
(while (< pos (length (substring reference (+ common-pos 1))))
(if (eq (aref reduced-path-reference pos) (aref "/" 0))
(setq depth (+ depth 1)))
(setq pos (+ pos 1)))
(dotimes (i depth)
(setq retval (concat retval "../")))
(setq retval (concat retval (substring filename common-pos)))
retval))
It has not been tested very thoroughly, however, in my simple testcases it worked as expected. Given a file filename and a reference directory reference (must have trailing slash, I can't remember which function does this automatically, can someone comment?) this function will calculate the relative path from reference to filename.
Example:
(file-name-make-relative "/usr/local/bin/exec" "/usr/local/root/bin/")
Result:
"../../bin/exec"
Install f.el, a comprehensive file and directory manipulation library. Then run function f-relative:
(f-relative "some/path/is/long" "some/path/was/short") ; => "../../is/long"
You can tweak this code to your needs:
(defun java-package-name (file)
"Generates package name for FILE, based on path."
(let* ((f (file-name-directory file))
(rem
(car
(sort
(delq nil
(mapcar
(lambda(x)
(and (string-match (expand-file-name x) f)
(substring f (match-end 0))))
(parse-colon-path (getenv "CLASSPATH"))))
(lambda (a b) (< (length a) (length b)))))))
(cond
((null rem)
"Not on CLASSPATH.")
((= 0 (length rem))
"At root of CLASSPATH")
(t
(mapconcat
#'downcase
(delete "" (split-string rem "[\\\\/]"))
".")))))
I'm looking for an emacs command that will toggle the surrounding quote characters on the string under the point, e.g. with the cursor in the string 'bar', hit a key and change it between:
foo = 'bar' <---> foo = "bar"
For bonus points it would:
handle toggling Python triple-quote strings (''' <---> """)
automatically change backslash escaping inside the string as appropriate.
e.g.
foo = 'bar "quote"' <---> foo = "bar \"quote\""
This could be a bit more robust:
(defun toggle-quotes ()
(interactive)
(save-excursion
(let ((start (nth 8 (syntax-ppss)))
(quote-length 0) sub kind replacement)
(goto-char start)
(setq sub (buffer-substring start (progn (forward-sexp) (point)))
kind (aref sub 0))
(while (char-equal kind (aref sub 0))
(setq sub (substring sub 1)
quote-length (1+ quote-length)))
(setq sub (substring sub 0 (- (length sub) quote-length)))
(goto-char start)
(delete-region start (+ start (* 2 quote-length) (length sub)))
(setq kind (if (char-equal kind ?\") ?\' ?\"))
(loop for i from 0
for c across sub
for slash = (char-equal c ?\\)
then (if (and (not slash) (char-equal c ?\\)) t nil) do
(unless slash
(when (member c '(?\" ?\'))
(aset sub i
(if (char-equal kind ?\") ?\' ?\")))))
(setq replacement (make-string quote-length kind))
(insert replacement sub replacement))))
It will use syntax information from the buffer to find the quotes at the beginning of the string (that is given that the strings are quoted), and will also try to flip quotes inside the string, unless they are escaped with backslash - which looks like it could be a common case.
PS. I've just realized you also wanted it to find triple quotes, so her goes.
Here's a quick hack to get you started:
(defun toggle-quotes ()
"Toggle single quoted string to double or vice versa, and
flip the internal quotes as well. Best to run on the first
character of the string."
(interactive)
(save-excursion
(re-search-backward "[\"']")
(let* ((start (point))
(old-c (char-after start))
new-c)
(setq new-c
(case old-c
(?\" "'")
(?\' "\"")))
(setq old-c (char-to-string old-c))
(delete-char 1)
(insert new-c)
(re-search-forward old-c)
(backward-char 1)
(let ((end (point)))
(delete-char 1)
(insert new-c)
(replace-string new-c old-c nil (1+ start) end)))))
The function swaps the internal quotes to the opposite, which is close to bonus 2.
Here's something even more robust, in that it doesn't delete the whole text between the quotes (doing so prevents save-excursion from keeping the point where it was, which is a pain). Also handles (un)backslash-ing nested quotes.
(defun toggle-quotes ()
(interactive)
(let* ((beg (nth 8 (syntax-ppss)))
(orig-quote (char-after beg))
(new-quote (case orig-quote
(?\' ?\")
(?\" ?\'))))
(save-restriction
(widen)
(save-excursion
(catch 'done
(unless new-quote
(message "Not inside a string")
(throw 'done nil))
(goto-char beg)
(delete-char 1)
(insert-char new-quote)
(while t
(cond ((eobp)
(throw 'done nil))
((= (char-after) orig-quote)
(delete-char 1)
(insert-char new-quote)
(throw 'done nil))
((= (char-after) ?\\)
(forward-char 1)
(when (= (char-after) orig-quote)
(delete-char -1))
(forward-char 1))
((= (char-after) new-quote)
(insert-char ?\\)
(forward-char 1))
(t (forward-char 1)))))))))
Here's a function I made for JavaScript, might help?
function swap_str(e, r, t) {
return e = e.split(r).join("WHAK_a_SWAP"), e = e.split(t).join("WHAK_b_SWAP"), e = e.split("WHAK_a_SWAP").join(t),
e = e.split("WHAK_b_SWAP").join(r);
}
//test 1
var str = 'this is "test" of a \'test\' of swapping strings';
var manipulated = swap_str(str,"'",'"');
document.writeln(manipulated)
//test 2
manipulated = swap_str(manipulated,"'",'"');
document.writeln('<hr>'+manipulated)