Author Topic: textbox  (Read 3004 times)

0 Members and 1 Guest are viewing this topic.

jtoverka

  • Newt
  • Posts: 127
textbox
« on: March 18, 2020, 08:39:57 PM »
So autoLisp has the textbox command
Code: [Select]
(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.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: textbox
« Reply #1 on: March 18, 2020, 09:26:36 PM »
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.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

jtoverka

  • Newt
  • Posts: 127
Re: textbox
« Reply #2 on: March 18, 2020, 09:42:57 PM »
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.

Code: [Select]
((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))
    )
  )
))

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: textbox
« Reply #3 on: March 18, 2020, 10:18:06 PM »
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.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: textbox
« Reply #4 on: March 20, 2020, 09:17:36 AM »
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
I've reached the age where the happy hour is a nap. (°Ώ°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

jtoverka

  • Newt
  • Posts: 127
Re: textbox
« Reply #5 on: March 22, 2020, 01:39:25 AM »
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.

Code: [Select]
; 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
)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: textbox
« Reply #6 on: March 22, 2020, 02:59:09 PM »
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:



Notes:
1. Z coord dumped for clarity
2. Normalized means distilled to delta x, delta y.

/FWIW
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

jtoverka

  • Newt
  • Posts: 127
Re: textbox
« Reply #7 on: March 22, 2020, 04:30:41 PM »
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.

jtoverka

  • Newt
  • Posts: 127
Re: textbox
« Reply #8 on: March 22, 2020, 09:00:41 PM »
Check the code below, I cannot seem to get the bounding box. That is why I created that textboxODBX function.
Code: [Select]
; 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)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: textbox
« Reply #9 on: March 22, 2020, 10:09:31 PM »
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):

Code: [Select]
(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.
« Last Edit: March 23, 2020, 12:05:19 AM by MP »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

jtoverka

  • Newt
  • Posts: 127
Re: textbox
« Reply #10 on: March 23, 2020, 07:12:25 AM »
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.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: textbox
« Reply #11 on: March 23, 2020, 07:48:33 AM »
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.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

ahsattarian

  • Newt
  • Posts: 112
Re: textbox
« Reply #12 on: November 22, 2020, 08:38:52 AM »
This Helps u   :




Code: [Select]
(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
« Last Edit: November 22, 2020, 05:40:23 PM by CAB »