LISP routine changes justification unnecessarily

LISP routine changes justification unnecessarily

EPennPH4G6
Explorer Explorer
271 Views
2 Replies
Message 1 of 3

LISP routine changes justification unnecessarily

EPennPH4G6
Explorer
Explorer

so here's a lisp i created that will search a directory for all dwgs in that folder. it'll open, swap text and change attributes of specified tags. it works as designed, but i noticed on the line/line2/line3 the justification changes. but when i open the block editor, they're all set to center, and in the enhanced attribute editor the justifications are still set at center. when i tab through the height/width factor the text snaps back to its correct position. is this a bug? i tried to redraw, regen and it wont snap back. it only snaps back to center if i tab through the dialog boxes. 

 

 

(defun c:SwapTextAndUpdateAttributes (/ oldTexts newTexts attributeTags attributeValues folderPath startTime endTime executionTime files acad changedFiles unchangedFiles changeLog fullPath doc changesMade atts att attValue textIndex newStr i obj ent textObj changeDetails tagIndex tagName newValue layers layerStates)
; Define the old and new text pairs
(setq oldTexts '(
"XXXX"
))

(setq newTexts '(
"XXXXX"
))

; Define the attribute tags and their new values
(setq attributeTags '("LINE" "LINE2" "LINE3"))
(setq attributeValues '("WILLIAMS INTERCONNECT" "AREA CLASSIFICATION" "BRADFORD COUNTY, PENNSYLVANIA"))

(setq folderPath "C:\\Python XREF\\") ; Update folder path to the new folder on the C: drive

; Function to unlock all layers
(defun unlock-layers ()
(vlax-for layer (vla-get-layers (vla-get-ActiveDocument acad))
(vla-put-lock layer :vlax-false)
)
)

; Function to store the state of all layers
(defun store-layer-states ()
(setq layers (vla-get-layers (vla-get-ActiveDocument acad)))
(setq layerStates '())
(vlax-for layer layers
(setq layerStates (cons (list (vla-get-name layer) (vla-get-lock layer)) layerStates))
)
)

; Function to restore the state of all layers
(defun restore-layer-states (layerStates)
(foreach state layerStates
(setq layer (vla-item layers (car state)))
(vla-put-lock layer (cadr state))
)
)

; Function to replace text while keeping formatting codes intact
(defun replace-text (text oldTexts newTexts)
(setq i 0)
(foreach oldText oldTexts
(setq text (vl-string-subst (nth i newTexts) oldText text))
(setq i (1+ i))
)
text
)

; Start timer
(setq startTime (getvar "TIMER"))

(setq files (vl-directory-files folderPath "*.dwg"))
(setq acad (vlax-get-acad-object))

(setq changedFiles '())
(setq unchangedFiles '())

; Create a change log for detailed changes
(setq changeLog (open (strcat folderPath "detailed_changes.txt") "w"))

(foreach file files
(setq fullPath (strcat folderPath file))

(if (findfile fullPath)
(progn
(setq doc (vla-open (vla-get-documents acad) fullPath))
(if doc
(progn
(setq changesMade nil)
(vla-startundomark doc)

; Store and unlock layer states
(store-layer-states)
(unlock-layers)

; Initialize change details for the current drawing
(setq changeDetails (strcat "\nChanges in " fullPath ":"))

; Iterate through all entities in the drawing
(vlax-for obj (vla-get-blocks doc)
(vlax-for ent obj
(if (or (= (vla-get-objectname ent) "AcDbBlockReference")
(= (vla-get-objectname ent) "AcDbText")
(= (vla-get-objectname ent) "AcDbMText"))
(progn
(if (= (vla-get-objectname ent) "AcDbBlockReference")
(setq atts (vlax-invoke ent 'GetAttributes))
(setq atts (list ent)))

; Update text entities
(foreach att atts
(setq attValue (vla-get-textstring att))
(setq newStr (replace-text attValue oldTexts newTexts))
(if (not (equal attValue newStr))
(progn
(vla-put-textstring att newStr)
(setq changesMade t)
(setq changeDetails (strcat changeDetails "\n- Replaced text: " attValue " with: " newStr))
)
)
)

; Update attributes
(if (= (vla-get-objectname ent) "AcDbBlockReference")
(progn
(setq atts (vlax-invoke ent 'GetAttributes))
(foreach att atts
(setq tagName (strcase (vla-get-tagstring att)))
(setq tagIndex (vl-position tagName attributeTags))

(if tagIndex
(progn
(setq newValue (nth tagIndex attributeValues))
(vla-put-textstring att newValue)
(setq changesMade t)
(setq changeDetails (strcat changeDetails "\n- Updated attribute tag: " tagName " to: " newValue))
)
)
)
)
)
)
)
)
)

; Restore original layer states
(restore-layer-states layerStates)

; Save the drawing only if changes were made
(if changesMade
(progn
(vla-endundomark doc)
(vla-save doc)
(princ (strcat "\nChanges saved successfully: " fullPath))
(setq changedFiles (cons fullPath changedFiles))
(write-line changeDetails changeLog)
)
(progn
(princ (strcat "\nNo changes made: " fullPath))
(setq unchangedFiles (cons fullPath unchangedFiles))
)
)

(vla-close doc)
)
(princ (strcat "\nError opening file: " fullPath))
)
)
(princ (strcat "\nFile not found: " fullPath))
)
)

; Stop timer
(setq endTime (getvar "TIMER"))

; Calculate and display execution time if both start and end times are valid
(if (and startTime endTime)
(progn
(setq executionTime (- endTime startTime))
(princ (strcat "\nExecution time: " (rtos executionTime 2 2) " seconds"))
)
)

; Write summary to a text file
(setq outputFilePath (strcat folderPath "changes_summary.txt"))
(setq outputFile (open outputFilePath "w"))
(write-line "Changed files:" outputFile)
(foreach file changedFiles
(write-line (strcat "- " file) outputFile)
)
(write-line "" outputFile)
(write-line "Unchanged files:" outputFile)
(foreach file unchangedFiles
(write-line (strcat "- " file) outputFile)
)
(write-line "" outputFile)
(if (and startTime endTime)
(progn
(write-line (strcat "Execution time: " (rtos executionTime 2 2) " seconds") outputFile)
)
)
(close outputFile)
(close changeLog)

(princ "\nText replacement and attribute updates complete.")
(princ)
)

0 Likes
272 Views
2 Replies
Replies (2)
Message 2 of 3

LDShaw
Collaborator
Collaborator

That's a pretty specific lisp. Can you supply a dwg and the block it relates to to try it? 

On the surface 

(foreach att atts
  (setq attValue (vla-get-textstring att))
  (setq newStr (replace-text attValue oldTexts newTexts))
  (if (not (equal attValue newStr))
    (progn
      (vla-put-textstring att newStr)
      (setq changesMade t)
      (setq changeDetails (strcat changeDetails "\n- Replaced text: " attValue " with: " newStr))
    )
  )
)

Is just pulling up the text. I don't see where your storing the justification. 

0 Likes
Message 3 of 3

ec-cad
Collaborator
Collaborator

Try putting an (vla-update object) in the loop somewhere if target is an Object.

Or, (entupd ent) if target is an entity.

What version of Acad are you using ?

 

 

ECCAD

 

0 Likes