Recent Posts
Object Properties
3 - [ LWPOLYLINE ]
Elevation: 0.0
Length: 1.0
Layer: 0
Color: 7
Linetype: Continuous
Plottable: YES
2 - [ INSERT - Nautical Golf Course Site 2d|CROSS ]
Objects Within Block: 4
Layer: Nautical Golf Course Site 2d|SHEET_GRID
Color: 8
Linetype: Continuous
Plottable: YES
1 - [ XREF - Nautical Golf Course Site 2d ]
Objects Within Block: 15896
Layer: B-Nautical|xref
Color: 7
Linetype: Continuous
Plottable: YES
0 - [ XREF - B-Nautical ]
Objects Within Block: 2
Layer: xref
Color: 2
Linetype: Continuous
Plottable: YES
(defun c:OBJTREE ( / mp-doc mp-get mp-get-obj-name mp-get-object-tree mp-get-owner mp-main mp-select-props-to-string mp-select-props-to-string-aux )
(vl-load-com)
(defun mp-doc ( )
(eval
(list
'defun 'mp-doc nil
(vla-get-activedocument (vlax-get-acad-object))
)
)
(mp-doc)
)
(defun mp-get-owner ( object )
(eval
(list 'defun 'mp-get-owner '( object / owner )
(list 'vl-catch-all-apply
(list 'function
(list 'lambda nil
(list 'setq 'owner
(list
'vla-objectidtoobject
(vla-get-activedocument (vlax-get-acad-object))
(list 'vla-get-ownerid 'object)
)
)
)
)
)
'owner
)
)
(mp-get-owner object )
)
(defun mp-get-object-tree ( object )
( (lambda ( tree / owner )
(while (setq owner (mp-get-owner (car tree)))
(setq tree (cons owner tree))
)
tree
)
(list object)
)
)
(defun mp-get ( x prop / value )
(vl-catch-all-apply 'eval '((setq value (vlax-get-property x prop))))
(cond
( (null value) nil)
( (eq 'variant (type value)) (vlax-get x prop))
( (/= "OBJECTNAME" (vl-symbol-name prop)) value)
( (/= "AcDbBlockReference" value) (substr value 5))
( (eq :vlax-true
(vla-get-isxref
(vla-item (vla-get-blocks (mp-doc)) (vla-get-name x))
)
)
"ExternalReference"
)
( (substr value 5) )
)
)
(defun mp-get-obj-name ( x / name )
(if (setq name (mp-get x 'objectname))
(if (wcmatch name "AcDb*")
(substr name 5)
name
)
)
)
(defun mp-select-props-to-string-aux ( x prop pfx / label value str n )
(if (setq value (mp-get x prop))
(strcat
pfx
(if (eq 'objectname prop)
"Object"
(strcat
(substr (setq label (vl-symbol-name prop)) 1 1)
(strcase (substr label 2) t)
)
)
": "
(if (< 60 (setq n (strlen (setq str (vl-prin1-to-string value)))))
(strcat (substr str 1 26) " ... " (substr str (- n 26)))
str
)
)
""
)
)
(defun mp-select-props-to-string ( x pfx )
(strcat
(apply 'strcat
(cons "\n"
(mapcar
(function (lambda (p) (mp-select-props-to-string-aux x p pfx)))
(append
'(objectname handle name)
(if (/= (mp-get x 'name) (mp-get x 'effectivename))
'(effectivename)
)
(if (mp-get x 'path)
'(path)
'(isdynamicblock islayout isxref hasattributes)
)
'( count
units
layer
insertionpoint
startpoint
endpoint
coordinates
elevation
xscalefactor
yscalefactor
zscalefactor
rotation
color
linetype
stylename
height
tagstring
textstring
)
)
)
)
)
)
)
(defun mp-main ( / pfx tab lst foo )
(cond
( (null
(setq
pfx "\n "
tab " "
lst (nentsel "\nSelect entity: ")
)
)
)
( (null
(defun foo ( x ) ;; uses lexical globals pdx & tab
(princ
(strcat
"\n\nDocument: \""
(vla-get-fullname (mp-doc))
"\""
)
)
(defun foo ( x )
(princ (mp-select-props-to-string x pfx))
(setq pfx (strcat pfx tab))
)
)
)
)
( (eq 2 (length lst))
(foreach x (cons 42 (mp-get-object-tree (vlax-ename->vla-object (car lst))))
(foo x)
)
)
( (foreach x
(cons 42
(append
(mp-get-object-tree
(mp-get-owner
(car
(setq lst
(mapcar 'vlax-ename->vla-object
(append
(reverse (last lst))
(list (car lst))
)
)
)
)
)
)
lst
)
)
(foo x)
)
)
)
(princ)
)
;; Sample output:
;;
;; Document: "D:\Clients\ME\XREF_TESTS\HOST.dwg"
;;
;; Object: "BlockTable"
;; Handle: "1"
;; Count: 13
;;
;; Object: "BlockTableRecord"
;; Handle: "70"
;; Name: "*Model_Space"
;; Isdynamicblock: :vlax-false
;; Islayout: :vlax-true
;; Isxref: :vlax-false
;; Count: 53
;; Units: 0
;;
;; Object: "ExternalReference"
;; Handle: "3F0"
;; Name: "DWG-0000"
;; Path: ".\\DWG-0000.dwg"
;; Layer: "0"
;; Insertionpoint: (0.0 0.0 0.0)
;; Xscalefactor: 1.0
;; Yscalefactor: 1.0
;; Zscalefactor: 1.0
;; Rotation: 0.0
;; Color: 256
;; Linetype: "ByLayer"
;;
;; Object: "Text"
;; Handle: "5AD"
;; Layer: "0"
;; Insertionpoint: (-133.778 295.91 0.0)
;; Rotation: 0.0
;; Color: 2
;; Linetype: "ByLayer"
;; Stylename: "DWG-0000|Standard"
;; Height: 1.0
;; Textstring: "DWG-0000"
(mp-main)
);;
;; Commande: ATT_ADD
;; par Gilles Chanteau (Anciennement ADDATT) - http://gilecad.azurewebsites.net/Lisp.aspx
;; Pour ajouter/soustraire une valeur numerique SIMPLE
;; a un Attribut SIMPLE sur un Bloc SIMPLE
;; Modifiée le 15/10/2020 - Luna
;; -> Ajout de la prise en compte de blocs dynamiques et modification de l'application des fonctions
;; -> Utilisation des fonctions (setpropertyvalue) et (getpropertyvalue) apparues depuis 2014 (?)
(defun c:ATT_ADD (/ Get-att-list att lst tag blc name add ss n val txt)
(defun Get-att-list (ename / Att Att_List)
(setq Att_List (mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke (vlax-ename->vla-object ename) 'getattributes)))
)
(if (and
(setq att (car (nentsel "\nSelectionnez UN Attribut a modifier: ")))
(setq lst (entget att))
(= (cdr (assoc 0 lst)) "ATTRIB")
(numberp (read (cdr (assoc 1 lst)))) ;; Uniquement si le nombre correspond au premier caractère de l'attribut !
(setq tag (cdr (assoc 2 lst)))
(setq blc (entget (cdr (assoc 330 lst))))
(setq name (getpropertyvalue (cdr (assoc -1 blc)) "BlockTableRecord/Name"))
(princ "\nSelectionnez les Blocs a modifier ")
(if (setq ss (ssget (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))))
(repeat (setq n (sslength ss))
(if (and
(wcmatch (getpropertyvalue (ssname ss (setq n (1- n))) "ClassName") "AcDbAssociative*Array")
(/= (getpropertyvalue (ssname ss n) "BlockTableRecord/Name") name)
)
(ssdel (ssname ss n) ss)
(sssetfirst nil ss)
)
)
(princ "\nAucun jeu de sélection valide...")
)
(setq add (getreal "\nEntrez la valeur a ajouter ou soustraire : "))
)
(while (setq blc (ssname ss n))
(if (and
(assoc tag (setq att-list (get-att-list blc)))
(numberp (read (setq val (getpropertyvalue blc tag))))
(cond
((or (= (type (read val)) 'REAL) (= (type add) 'REAL))
(setq txt (rtos (+ (read val) add)))
)
((and (= (type (read val)) 'INT) (= (type add) 'INT))
(setq txt (itoa (+ (read val) add)))
)
)
)
(setpropertyvalue blc tag (strcat txt (vl-string-left-trim "0123456789." val)))
)
(setq n (1+ n))
)
(princ "\nL Objet selectionne n'est pas un attribut ! ")
)
(princ)
)
My tenacious problem solving and innovation expertise does not come across on paper or map to today's HR filtering methods. Add "born with a face for radio" and a "voice for print" I'd have to reluctantly acknowledge "no". I've been steadily employed for decades strictly on word of mouth recommendations and testimonials, a strategy that is no longer in vogue. As a result have frequently considered leaving the industry to write a book for CAD support professionals who are thanklessly tasked to perform the work of dozens++ of design drafters at the eleventh miracle hour - the book I wished I had in my arsenal 20+ years ago.
Thanks for providing the code.
I tried to run it after adding the path. The program was stuck though, whatever it was processing required a lot of memory. There was no error message in the command line.
The way I added the support path was: Tools, Options, Support File Search Path, Add. Added "C:\Drawing Conversion". Tried moving to the top, restarting, etc, no luck.
The only thing I could think of was adding "\\" after the "list.txt" using "strcat" ... but got an error message.Code: [Select](setq pth (vl-filename-directory strcat tx1 "\\")