TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: jtoverka on March 18, 2020, 08:39:57 PM
-
So autoLisp has the textbox command
(textbox elist)
Does anyone have the visual lisp equivalent? I would like to be able to use objectDBX. It won't work if I have different textstyle settings in my current drawing compared to the drawing I am trying use this command on.
-
Thinking out loud ...
1. You can use textbox in objectdbx tho the same restrictions (e.g. style) would apply.
2. Is there an issue defining a textstyle that sports the properties you want? Could be nuked when you're done with it.
3. You could use the getboundingbox method if there's an actual text/mtext/attrib/attdef object to examine (textstring cannot be null).
4. You can create a junk object dbx doc and use / discard to suit.
-
Thinking out loud ...
1. You can use textbox in objectdbx tho the same restrictions (e.g. style) would apply.
2. Is there an issue defining a textstyle that sports the properties you want? Could be nuked when you're done with it.
I am considering using this if all else fails.
3. You could use the getboundingbox method if there's an actual text/mtext/attrib/attdef object to examine (textstring cannot be null).
4. You can create a junk object dbx doc and use / discard to suit.
I just tried doing number 3. I can't get it to work.
((lambda ( / document blockName textSize offset2D pItem_lay polygonFit polygonGap polygonDiameter)
;; variables for debugging
(setq document (vla-get-activeDocument (vlax-get-acad-object)))
(setq blockName "PNL100")
(setq textSize "0.25")
(setq offset2D '(0 0))
(setq PITEM_LAY "PITEM")
(setq PBAL_LAY "PBAL")
(setq polygonFit "1")
(setq polygonGap "0.1")
(setq polygonDiameter "0.625")
;; snippet below
; Create WD textstyle if one does not exist
( (lambda (document / textStyles textStyle found)
(setq textStyles (vla-get-textStyles document))
(setq found (vl-catch-all-apply 'vla-item (list textStyles "WD")))
(if (vl-catch-all-error-p found)
(progn
(setq textStyle (vla-add textStyles "WD"))
(vla-put-fontFile textStyle "sanss___.ttf")
(vla-put-LastHeight textStyle 0.125)
(vla-put-Width textStyle 1.0)
)
)
)
document
)
; Create pBal_lay if one does not exist
( (lambda (document pBal_lay / layers layer found)
(setq layers (vla-get-layers document))
(setq found (vl-catch-all-apply 'vla-item (list layers pBal_lay)))
(if (vl-catch-all-error-p found)
(progn
(setq layer (vla-add layers pBal_lay))
)
)
)
document pBal_lay
)
; Create pItem_lay if one does not exist
( (lambda (document pItem_Lay / layers layer found)
(setq layers (vla-get-layers document))
(setq found (vl-catch-all-apply 'vla-item (list layers pItem_Lay)))
(if (vl-catch-all-error-p found)
(progn
(setq layer (vla-add layers pItem_Lay))
)
)
)
document pItem_Lay
)
(setq blocks (vla-get-blocks document))
(setq block (vla-add blocks (vlax-3d-point 0 0 0) blockName))
(vlax-for object block
(vla-Delete object)
)
(setq
attributeObject
(vla-addAttribute
block ; object
(atof textSize) ; attheight
0 ; attMode
"" ; attPrompt
(vlax-3d-point ; insertionPoint
(reverse (cons 0.0 (reverse offset2D)))
)
"B_ITEM" ; attTag
"AA" ; attValue
)
)
(vla-put-Alignment attributeObject acAlignmentMiddle)
(vla-put-Layer attributeObject PITEM_LAY)
(vla-put-StyleName attributeObject "WD")
(vla-put-ScaleFactor attributeObject 0.8)
(if (wcmatch polygonFit "1")
(progn
(vla-GetBoundingBox attributeObject 'minExt 'maxExt)
(setq minExt (vlax->list minExt))
(setq maxExt (vlax->list maxExt))
(setq center (mapcar '/ (mapcar '+ minExt maxExt) '(2 2 2)))
(setq gap (atof polygonGap))
(setq radius
(distance
(mapcar '+
center
(rotatePoint
center
(list gap 0 0)
(angle
center
minExt
)
)
)
)
)
(setq origin2D '(0 0))
)
(progn
(setq diameter (atof polygonDiameter))
(setq radius (/ diameter 2))
(setq origin2D '(0 0))
)
)
))
-
I’m on my iPad so no can test code. However, I use getboundingbox in objectdbx frequently - successfully - to wit - have quasi ssget crossing type functions based on same for use in objectdbx.
Do note that objects with the textstring property can’t have empty ("") strings - test for said condition, temporarily assigning a standard string (I use "-" IIRC) before a getboundingbox call, then restoring "" afterward in order to determine a "standard minimum bounding box size for null text items".
Long day pounding code - kinda burnt out - hope that made sense - cheers.
-
Not sure this will be of any use but you can take a look at this old routine.http://www.theswamp.org/index.php?topic=7003.0
-
This was a lot harder than it should have been. For some reason I can't make a block attribute definition and store it into a variable and find the bounding box on that variable. However, if I create the block, go in block editor and get the object from the attribute definition, the GetBoundingBox method will work. I looked into it, and the handle produced from creating the attdef is not the same as the one where I select the attdef. I don't know what is going on there, but I have found a work around.
; Name: J. Overkamp
; Date: 03/21/2020
; Parameters:
; textObject - VLA-OBJECT attribute/attributeReference
; Return:
; bounding box
(defun JO:textboxODBX (textObject / *error* JO:findFontFile acadObject activeDocument document objectName
textHeight textString textRotation textWidth textObliqueAngle textStyleName textAlignment
textHorizontalAlignment textVerticalAlignment documentTextStyles activeDocumentTextStyles documentTextStyle
i newTextStyle newTextStyleName complete boundingBox textInsertionPoint
)
(defun *error* (msg / )
(acet-ui-progress-done)
(if (= 'VLA-OBJECT (type newTextStyle))
(vla-delete newTextStyle)
)
(princ "Error: ")
(princ msg)
(princ)
)
(defun JO:findFontFile (font / filePath path files)
(setq filePath (findfile font))
(if filePath
(progn
filePath
)
(progn
(setq path (strcat (getenv "windir") "\\Fonts\\"))
(setq files (vl-directory-files path "*"))
(if (member font files)
(strcat path font)
)
)
)
)
(if
(and
(setq objectName (vla-get-objectName textObject))
(wcmatch objectName "AcDbAttributeReference,AcDbAttributeDefinition,AcDbAttribute")
)
(progn
(setq acadObject (vlax-get-acad-object))
(setq activeDocument (vla-get-activeDocument acadObject))
(setq document (vla-get-document textObject))
(setq textHeight (vla-get-Height textObject))
(setq textString (vla-get-TextString textObject))
(setq textRotation (vla-get-Rotation textObject))
(setq textWidth (vla-get-ScaleFactor textObject))
(setq textObliqueAngle (vla-get-ObliqueAngle textObject))
(setq textStyleName (vla-get-StyleName textObject))
(setq textAlignment (vla-get-alignment textObject))
(cond
((= textAlignment acAlignmentLeft)
(setq textHorizontalAlignment 0)
(setq textVerticalAlignment 0)
)
((= textAlignment acAlignmentCenter)
(setq textHorizontalAlignment 1)
(setq textVerticalAlignment 0)
)
((= textAlignment acAlignmentRight)
(setq textHorizontalAlignment 2)
(setq textVerticalAlignment 0)
)
((= textAlignment acAlignmentAligned)
(setq textHorizontalAlignment 3)
(setq textVerticalAlignment 0)
)
((= textAlignment acAlignmentMiddle)
(setq textHorizontalAlignment 4)
(setq textVerticalAlignment 0)
)
((= textAlignment acAlignmentFit)
(setq textHorizontalAlignment 5)
(setq textVerticalAlignment 0)
)
((= textAlignment acAlignmentTopLeft)
(setq textHorizontalAlignment 0)
(setq textVerticalAlignment 3)
)
((= textAlignment acAlignmentTopCenter)
(setq textHorizontalAlignment 1)
(setq textVerticalAlignment 3)
)
((= textAlignment acAlignmentTopRight)
(setq textHorizontalAlignment 2)
(setq textVerticalAlignment 3)
)
((= textAlignment acAlignmentMiddleLeft)
(setq textHorizontalAlignment 0)
(setq textVerticalAlignment 2)
)
((= textAlignment acAlignmentMiddleCenter)
(setq textHorizontalAlignment 1)
(setq textVerticalAlignment 2)
)
((= textAlignment acAlignmentMiddleRight)
(setq textHorizontalAlignment 2)
(setq textVerticalAlignment 2)
)
((= textAlignment acAlignmentBottomLeft)
(setq textHorizontalAlignment 0)
(setq textVerticalAlignment 1)
)
((= textAlignment acAlignmentBottomCenter)
(setq textHorizontalAlignment 1)
(setq textVerticalAlignment 1)
)
((= textAlignment acAlignmentBottomRight)
(setq textHorizontalAlignment 2)
(setq textVerticalAlignment 1)
)
)
(setq documentTextStyles (vla-get-TextStyles document))
(setq activeDocumentTextStyles (vla-get-TextStyles activeDocument))
(setq documentTextStyle (vla-Item documentTextStyles textStyleName))
(setq i 0)
(while
(and
(setq i (1+ i))
(not complete)
)
(setq newTextStyleName (strcat textStyleName (itoa i)))
(if
(and
(vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list activeDocumentTextStyles newTextStyleName)))
(vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list documentTextStyles newTextStyleName)))
)
(progn
(setq newTextStyle (vla-add activeDocumentTextStyles newTextStyleName))
(setq complete T)
)
)
)
(setq bigFontFile
(JO:findFontFile (vla-get-BigFontFile documentTextStyle))
)
(if bigFontFile
(vla-put-BigFontFile newTextStyle bigFontFile)
)
(setq fontFile
(JO:findFontFile (vla-get-FontFile documentTextStyle))
)
(if fontFile
(vla-put-FontFile newTextStyle fontFile)
)
(vla-put-Height newTextStyle (vla-get-Height documentTextStyle))
(vla-put-LastHeight newTextStyle (vla-get-LastHeight documentTextStyle))
(vla-put-ObliqueAngle newTextStyle (vla-get-ObliqueAngle documentTextStyle))
(vla-put-TextGenerationFlag newTextStyle (vla-get-TextGenerationFlag documentTextStyle))
(vla-put-Width newTextStyle (vla-get-Width documentTextStyle))
(cond
((wcmatch objectName "AcDbAttributeReference,AcDbAttributeDefinition,AcDbAttribute")
(setq boundingBox
(textbox
(list
(cons 40 textHeight)
(cons 1 textString)
(cons 50 textRotation)
(cons 41 textWidth)
(cons 51 textObliqueAngle)
(cons 7 newTextStyleName)
(cons 72 textHorizontalAlignment)
(cons 74 textVerticalAlignment)
)
)
)
(if (not boundingBox)
(progn
(setq textInsertionPoint (vla-get-insertionPoint textObject))
(setq boundingBox (list textInsertionPoint textInsertionPoint))
)
)
)
)
(vla-delete newTextStyle)
)
)
boundingBox
)
-
Here's the results of a quick test I just ran. I created a block def hosting 2 attdefs, one based on a shx font (romans), the other on a true type font (arial). I created an instance and then queried the attribs by the textbox function and the getboundingbox method, in the active drawing, via ODBX in a drawing that had both styles defined, and via ODBX in another drawing that had neither style defined. My observations:
(http://www.dropbox.com/s/ikqftbelmqn2668/textbox-vs-getboundingbox.png?raw=1)
Notes:
1. Z coord dumped for clarity
2. Normalized means distilled to delta x, delta y.
/FWIW
-
Here's the results of a quick test I just ran. I created a block def hosting 2 attdefs, one based on a shx font (romans), the other on a true type font (arial). I created an instance and then queried the attribs by the textbox function and the getboundingbox method, in the active drawing, via ODBX in a drawing that had both styles defined, and via ODBX in another drawing that had neither style defined.
Was this block created and saved in a drawing prior to running the textbox vs getBoundingBox methods? I can use getBoundingBox if it the attribute definition is already created. However, if I create it in autoLISP and save that object to a variable, then run the getBoundingBox, it fails.
-
Check the code below, I cannot seem to get the bounding box. That is why I created that textboxODBX function.
; Name: J. Overkamp
; Date: 03/18/2020
; Parameters:
; document - document object
; blockName - string blockname for balloon
; defaultTextString - string to use as the item number
; circleDiameter - string from BALL_CDIA from WD_PNLM
; circleGap - string from BALL_CGAP from WD_PNLM
; circleFit - string from BALL_CFIT from WD_PNLM
; offset2D - reposition block
; pBal_lay - string from PBAL_LAY from WD_PNLM
; pItem_lay - string from PBAL_LAY from WD_PNLM
; Function:
; Create a circle balloon block definition
; Return:
; vla block definition
(defun JO:circleBalloonBlock (document blockName defaultTextString circleDiameter circleGap circleFit textSize offset2D pBal_lay pItem_lay / blocks block attributeObject boundingBox diameter radius origin2D circle)
; Create WD textstyle if one does not exist
( (lambda (document / textStyles textStyle found)
(setq textStyles (vla-get-textStyles document))
(setq found (vl-catch-all-apply 'vla-item (list textStyles "WD")))
(if (vl-catch-all-error-p found)
(progn
(setq textStyle (vla-add textStyles "WD"))
(vla-put-fontFile textStyle "sanss___.ttf")
(vla-put-LastHeight textStyle 0.125)
(vla-put-Width textStyle 1.0)
)
)
)
document
)
; Create pBal_lay if one does not exist
( (lambda (document pBal_lay / layers layer found)
(setq layers (vla-get-layers document))
(setq found (vl-catch-all-apply 'vla-item (list layers pBal_lay)))
(if (vl-catch-all-error-p found)
(progn
(setq layer (vla-add layers pBal_lay))
)
)
)
document pBal_lay
)
; Create pItem_lay if one does not exist
( (lambda (document pItem_Lay / layers layer found)
(setq layers (vla-get-layers document))
(setq found (vl-catch-all-apply 'vla-item (list layers pItem_Lay)))
(if (vl-catch-all-error-p found)
(progn
(setq layer (vla-add layers pItem_Lay))
)
)
)
document pItem_Lay
)
(setq blocks (vla-get-blocks document))
(setq block (vla-add blocks (vlax-3d-point 0 0 0) blockName))
(setq
attributeObject
(vla-addAttribute
block ; object
(atof textSize) ; attheight
0 ; attMode
"" ; attPrompt
(vlax-3d-point ; insertionPoint
(reverse (cons 0.0 (reverse offset2D)))
)
"B_ITEM" ; attTag
"" ; attValue
)
)
(vla-put-alignment attributeObject acAlignmentMiddle)
(vla-put-Layer attributeObject PITEM_LAY)
(vla-put-StyleName attributeObject "WD")
(vla-put-ScaleFactor attributeObject 0.8)
(or
defaultTextString
(setq defaultTextString "")
)
(if (wcmatch defaultTextString "")
(progn
(vla-put-TextString attributeObject "XX")
(setq boundingBox (JO:textboxODBX attributeObject))
(vla-put-TextString attributeObject defaultTextString)
)
(progn
(vla-put-TextString attributeObject defaultTextString)
(setq boundingBox (JO:textboxODBX attributeObject))
)
)
;(setq boundingBox (vl-catch-all-apply 'vla-getBoundingBox (list attributeObject))) ; <----------------------------------------------------- Returns ERROR when uncommented
(if (wcmatch circleFit "1")
(progn
(setq origin2D '(0 0))
(if boundingBox
(progn
(setq diameter
(+
(distance
(nth 0 boundingBox)
(nth 1 boundingBox)
)
(atof circleGap)
(atof circleGap)
)
)
)
(progn
(setq diameter (+ (atof circleGap) (atof textSize)))
)
)
(setq radius (/ diameter 2))
)
(progn
(setq diameter (atof circleDiameter))
(setq radius (/ diameter 2))
(setq origin2D '(0 0))
)
)
(setq circle
(vla-AddCircle block
(vlax-3d-point
(reverse (cons 0.0 (reverse offset2D)))
)
radius
)
)
(vla-put-layer circle PBAL_LAY)
block
)
(setq document (vla-get-activeDocument (vlax-get-acad-object)))
(JO:circleBalloonBlock document "PNL1000" "9" "0.5" "0.25" "1" "0.25" '(0 0) "PBAL" "PITEM")
(princ)
-
The GetBoundingBox method works on attributes and attribute definitions provided the latter are hosted by the primary blocks (*Model_Space or *Paper_Space<n>). Said another way - the GetBoundingBox method will fail on attribute definitions hosted by a user defined block.
I've never had to do the latter (despite tons of the former) but if needed I'd create a temporary instance of the attribute definition of interest in *Model_Space or *Paper_Space using the properties as the original - capture the bounding box - then dump the temporary instance.
Quick and dirty example (untested but reasonably confident would work in odbx - edit: tested, works in odbx):
(defun get-attdef-bounding-box ( attdef / result )
(vl-catch-all-apply
'(lambda ( / doc ms layer props values temp foo )
(setq
ms (vla-get-modelspace (setq doc (vla-get-document attdef)))
layer (vla-item (vla-get-layers doc) (vla-get-layer attdef))
props '(height mode promptstring insertionpoint tagstring textstring)
values (mapcar '(lambda (p) (vlax-get attdef p)) props)
temp (apply 'vlax-invoke (append (list ms 'addattribute) values))
props (append '(scalefactor textalignmentpoint textgenerationflag upsidedown) props)
props (append '(alignment backward height obliqueangle stylename rotation) props)
foo (lambda (p) (vl-catch-all-apply '(lambda ( ) (vlax-put temp p (vlax-get attdef p)))))
)
(foreach p props (foo p))
(vlax-invoke-method temp 'GetBoundingBox 'a 'b)
(if a (setq result (mapcar 'vlax-safearray->list (list a b))))
(if (minusp (vlax-get layer 'lock))
(progn (vlax-put layer 'lock 0) (vlax-invoke temp 'delete) (vlax-put layer 'lock -1))
(vlax-invoke temp 'delete)
)
)
)
result
)
A complete aside - AutoCAD does some slight of hand block mgmt voodoo on behalf of the block edit command. If you examine objects while in the block edit environment you will notice the handles do not correspond to those in the actual block being edited. <edumacated guess> Said command creates a temporary block def matching the original block def every time the block edit command is invoked (i.e. handles increment every time). If changes are saved when exiting the block edit environment the original block def is revised per the changes in the temp block def.
Cheers.
-
So I tested the code and it gets the bounding box of the tag string and not the text string. I have an attribute called B_ITEM and it is getting the bounding box of that, whereas I want the bounding box of the text string which is generally a number between 1 and ~150. The method I made above does that.
-
Normal behaviour of a getboundingbox call on an attribute instance would reflect the value of the textstring property.
Normal behaviour of a getboundingbox call on an attribute definition would reflect the value of the tagstring property.
I am satisfied what I coded reflects this. Code could be written to spawn an attribute instance from an attribute definition but other fish wait impatiently in my pan.
You have a solution, all is good, cheers.
-
This Helps u :
(defun mytextbox (sj / lij)
(setq enj (entget sj))
(setq typj (strcase (cdr (assoc 0 enj)) t))
(cond
((= typj "text")
(setq hi (cdr (assoc 40 enj)))
(setq ang (cdr (assoc 50 enj)))
(setq tbx (textbox enj))
(command "ucs" "world")
(command "ucs" "origin" (trans (cdr (assoc 10 enj)) 0 1))
(command "ucs" "z" (* ang (/ 180.0 pi)))
(setq p1 (trans (car tbx) 1 0))
(setq p2 (trans (list (caadr tbx) (cadar tbx)) 1 0))
(setq p3 (trans (cadr tbx) 1 0))
(setq p4 (trans (list (caar tbx) (cadadr tbx)) 1 0))
(command "ucs" "world")
(setq lij (list p1 p2 p3 p4))
)
((= typj "mtext")
(setq wi (cdr (assoc 42 enj)))
(setq hi (cdr (assoc 43 enj)))
(setq po (trans (cdr (assoc 10 enj)) (cdr (assoc -1 en)) 1))
(setq ju (cdr (assoc 71 enj)))
(setq ang (cdr (assoc 50 enj)))
(cond
((= ju 1)
(setq p1 (polar po (- ang (* pi 0.5)) hi)) ; lower-left
(setq p2 (polar p1 ang wi)) ; lower-right
(setq p3 (polar po ang wi)) ; upper-right
(setq p4 po) ; upper-left
)
((= ju 2)
(setq p3 (polar po ang (/ wi 2)))
(setq p4 (polar po (+ ang pi) (/ wi 2)))
(setq p1 (polar p4 (- ang (* pi 0.5)) hi))
(setq p2 (polar p1 ang wi))
)
((= ju 3)
(setq p3 po)
(setq p4 (polar po (+ ang pi) wi))
(setq p1 (polar p4 (- ang (* pi 0.5)) hi))
(setq p2 (polar p1 ang wi))
)
((= ju 4)
(setq p4 (polar po (+ ang (* pi 0.5)) (/ hi 2)))
(setq p3 (polar p4 ang wi))
(setq p1 (polar p4 (- ang (* pi 0.5)) hi))
(setq p2 (polar p1 ang wi))
)
((= ju 5)
(setq p4 (polar po (- ang pi) (/ wi 2)))
(setq p4 (polar p4 (+ ang (* pi 0.5)) (/ hi 2)))
(setq p3 (polar p4 ang wi))
(setq p1 (polar p4 (- ang (* pi 0.5)) hi))
(setq p2 (polar p1 ang wi))
)
((= ju 6)
(setq p3 (polar po (+ ang (* pi 0.5)) (/ hi 2)))
(setq p4 (polar p3 (+ ang pi) wi))
(setq p1 (polar p4 (- ang (* pi 0.5)) hi))
(setq p2 (polar p1 ang wi))
)
((= ju 7)
(setq p1 po)
(setq p2 (polar p1 ang wi))
(setq p3 (polar p2 (+ ang (* pi 0.5)) hi))
(setq p4 (polar p1 (+ ang (* pi 0.5)) hi))
)
((= ju
(setq p1 (polar po (+ ang pi) (/ wi 2)))
(setq p2 (polar p1 ang wi))
(setq p3 (polar p2 (+ ang (* pi 0.5)) hi))
(setq p4 (polar p1 (+ ang (* pi 0.5)) hi))
)
((= ju 9)
(setq p2 po)
(setq p1 (polar po (+ ang pi) wi))
(setq p3 (polar p2 (+ ang (* pi 0.5)) hi))
(setq p4 (polar p1 (+ ang (* pi 0.5)) hi))
)
)
(setq lij (list p1 p2 p3 p4))
)
)
lij
)
Code Tags added by CAB