Author Topic: Object DBX text  (Read 1020 times)

0 Members and 1 Guest are viewing this topic.

jtoverka

  • Newt
  • Posts: 127
Object DBX text
« on: March 27, 2020, 10:05:58 AM »
So ODBX has a bug that does not position text correctly for non left justified text.

Is there a way to bypass this? I looked into Lee mac's batch find and replace to find the solution.
http://www.lee-mac.com/bfind.html

He has code to fix this.
Code: [Select]
  (defun _CalcInsPt ( obj str / e a )
    (setq e (entget (vlax-vla-object->ename obj))
          a (cdr (assoc 72 e))
    )
    (polar
      (vlax-get obj 'InsertionPoint)
      (vla-get-Rotation obj)
      (*
        (apply '+
          (mapcar
            (function (lambda ( e1 e2 ) (- (car e1) (car e2))))
            (textbox e)
            (textbox (subst (cons 1 str) (assoc 1 e) e))
          )
        )
        (cond
          ( (or (= a 1) (= a 4)) 0.5)
          ( (= a 2) 1.0)
          ( 0.0 )
        )
      )
    )
  )

I have modified this to account for the fact that you may not have the textstyle in the active drawing needed to perform the textbox operation.
Code: [Select]
; Name: J. Overkamp
; Date: 03/27/2020
; Parameters:
;   textStyle - Vla-object textstyle
; Function:
;   Make a copy of this textstyle with a new name
;   in the active drawing
; Return:
;   textStyle - Vla-object textstyle
(defun JO:copyTextStyle (textStyle / *error* JO:findFontFile acadObject activeDocument activeDocumentTextStyles document documentTextStyles textStyleName i complete bigFontFile fontFile newTextStyleName newTextStyle)
  (defun *error* (msg / )
    (acet-ui-progress-done)
    (if (= 'VLA-OBJECT (type newTextStyle))
      (vla-delete newTextStyle)
    )
    (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
      (vlax-release-object dbx)
    )
    (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
      (= 'VLA-OBJECT (type textStyle))
      (not (vlax-erased-p  textStyle))
      (vlax-read-enabled-p textStyle)
      (setq acadObject               (vlax-get-acad-object))
      (setq activeDocument           (vla-get-activeDocument acadObject))
      (setq activeDocumentTextStyles (vla-get-TextStyles     activeDocument))
      (setq document                 (vla-get-document       textStyle))
      (setq documentTextStyles       (vla-get-TextStyles     document))
      (setq textStyleName            (vla-get-Name           textStyle))
    )
    (progn
      (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))
    )
  )
  newTextStyle
)
; Name: J. Overkamp
; Date: 03/27/2020
; Parameters:
;   textObject - vla-object text object
;   textString - string
; Function:
;   Calculate the new insert point of the object
;
(defun JO:textInsertionPoint ( textObject textString / entity eList horizontalAlignment document textStyleName documentTextStyles documentTextStyle newTextStyle newTextStyleName insertionPoint acadObject activeDocument)
  (if
    (and
      (not (vlax-erased-p textObject))
      (vlax-read-enabled-p textObject)
      (setq entity (vlax-vla-object->ename textObject))
      (setq eList (entget entity))
      (setq horizontalAlignment (cdr (assoc 72 eList)))
     
      (setq acadObject               (vlax-get-acad-object))
      (setq activeDocument           (vla-get-activeDocument acadObject))
      (setq document                 (vla-get-document       textObject))
      (setq textStyleName            (vla-get-StyleName      textObject))
      (setq documentTextStyles       (vla-get-TextStyles     document))
      (setq documentTextStyle        (vla-Item documentTextStyles textStyleName))
      (if (equal activeDocument document)
        (and
          (setq newTextStyle documentTextStyle)
          (setq newTextStyleName textStyleName)
        )
        (and
          (setq newTextStyle (JO:copyTextStyle documentTextStyle))
          (setq newTextStyleName (vla-get-name newTextStyle))
        )
      )
      (setq eList
        (subst
          (cons 7 newTextStyleName)
          (assoc 7 eList)
          eList
        )
      )
    )
    (progn
      (setq insertionPoint
        (polar
          (vlax-get textObject 'InsertionPoint)
          (vla-get-Rotation textObject)
          (*
            (apply '+
              (mapcar
                '(lambda ( e1 e2 )
                  (- (car e1) (car e2))
                )
                (textbox eList)
                (textbox (subst (cons 1 textString) (assoc 1 eList) eList))
              )
            )
            (cond
              ( (or
                  (= horizontalAlignment 1)
                  (= horizontalAlignment 4)
                )
                0.5
              )
              ( (= horizontalAlignment 2)
                1.0
              )
              ( 0.0 )
            )
          )
        )
      )
      (if (not (equal activeDocument document))
        (vla-delete newTextStyle)
      )
    )
  )
  insertionPoint
)


The central point here is this, I create a block definition, I insert that block definition, I modify a single attribute. I modify the insert point using the above functions prior to putting in the textstring value.

After all of this, it does not work. I don't know what kind of voodoo lee mac uses to make his program work. Maybe the block definition and insert has something to do with it.