Jump to content

Merge Dimstyle & Text style after removing of binding prefix $0$

nababeer

By nababeer
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

nababeer Rookie

nababeer

Posted
Posted

Hi there,

 

I am using this lisp to remove binding Prefix from dimstyle name and textstyle name as well. After removing prefix some style names are matching existing names and that cancelling the renaming process. I need someone to modify this lisp (I don't know the developer name) to merge the style if its name after removing prefix will be typically matching other name of an existing style. Please help ! I googled this issue hundreds of times and i didn't find !

 

(defun c:RBP(/ ActDoc Name NewName)

(vl-load-com)

(defun RemoveBindPrefix (String / Pos LastPos)

(if (setq Pos (vl-string-search "$" String))

(progn

(setq LastPos Pos)

(while (setq Pos (vl-string-search "$" String (1+ Pos)))

(setq LastPos Pos)

)

(substr String (+ 2 LastPos))

)

String

)

)

(vlax-for Obj (vla-get-TextStyles ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Text style: " Name " was not renamed."))

)

)

)


(vlax-for Obj (vla-get-DimStyles ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Dimension style: " Name " was not renamed."))

)

)

)

(princ)

)

Link to comment
Share on other sites
  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • nababeer

    12

  • pBe

    6

  • Lee Mac

    3

  • jahbgd

    1

Popular Days

Top Posters In This Topic

Popular Days

nababeer Rookie

nababeer

Posted
  • Author
Posted

All of these links from google just provided me with this lisp included in my post . It is working well for removing prefix but it cannot merge similar names after removing prefix !

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted
All of these links from google just provided me with this lisp included in my post . It is working well for removing prefix but it cannot merge similar names after removing prefix !

 

Do you mind posting a sample drawing where we can test the code above and make the necessary adjustments

Link to comment
Share on other sites
nababeer Rookie

nababeer

Posted
  • Author
Posted

Thanks pBe for your quick response :)

 

Here is the drawing in this link .. I modified the lisp and added a line to perform layer merge , and it works well. But till now I cannot merge text styles and dimstyle !

 

(defun c:RBP(/ ActDoc Name NewName)

; RemoveBindPrefixes

; Renames layers, blocks, dimension styles, text styles, user coordinate systems, and views

; Merging layers with same name

; Ex: 422-G100-DF$0$Layer1 -> Layer1

(vl-load-com)

(defun RemoveBindPrefix (String / Pos LastPos)

(if (setq Pos (vl-string-search "$" String))

(progn

(setq LastPos Pos)

(while (setq Pos (vl-string-search "$" String (1+ Pos)))

(setq LastPos Pos)

)

(substr String (+ 2 LastPos))

)

String

)

)

;---------------------------------------------------------

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))

(vlax-for Obj (vla-get-Layers ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

;-----------------

;Merging layers with same name after removing Prefix

(command "-LAYMRG" "_Name" name "" "_Name" NewName "_Yes")
;-------------------

(prompt (strcat "\n Layer: " Name " was merged in Layer " NewName))

)

)

)

(vlax-for Obj (vla-get-Blocks ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Block: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-TextStyles ActDoc)

(setq Name (vla-get-Name Obj))


(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Text style: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-Views ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n View: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-UserCoordinateSystems ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n UCS: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-DimStyles ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

;MERGEDIM


(prompt (strcat "\n Dimension style: " Name " was not renamed."))

)

)

)

(princ)

)

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted

Sorry nababeer, I dont do 4shared. [/i]

 

Question: when faced with two identical Style name( or style already existing ) but different settings, what would you prefer to do? same goes with dimstyles.

Link to comment
Share on other sites
nababeer Rookie

nababeer

Posted
  • Author
Posted

Drawing11.dwg

Sorry nababeer, I dont do 4shared. [/i]

 

Question: when faced with two identical Style name( or style already existing ) but different settings, what would you prefer to do? same goes with dimstyles.

 

Here is a sample drawing in the attachment. You will find 2 layers (Layer1 & 1000$0$layer1) .. also dimstyle (Standard & 1000$0$Standard) and same for text style. I need to run the above lisp to remove this prefix to the last $ and if the remaining string will be duplicated with an existing name , they should be merged. Your reply shall be highly appreciated :)

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted
They should be merged.

 

Question: when faced with two identical Style name( or style already existing ) but different settings, what would you prefer to do?

 

Say for example there are no existing style same as the truncated xrefbind names and it so happens there are two of them. which setting will govern?

 

1000$0$Standard :

2000$0$Standard ;

 

Both will be Standard.... which font style will remain?

 

This is a general query and not specific on your posted sample drawing. Writing free codes here , we try to make it as usable not just for the OP but for anybody else looking for a similar routine.

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted
Both will be standard - Font :Arial

 

What if the style is not Arial but something else? Now that is exactly what i'm driving at nababeer, there are conditions that needs to be address first.

 

Describe the desired result thoroughly not the steps.

 

....Please help -_-...

 

You asked for help, at least do your part.

Link to comment
Share on other sites
nababeer Rookie

nababeer

Posted
  • Author
Posted

Ok, pBe

 

I don't know about conditions cause i am new in lisp. But the actual situation that I already convert all text styles font to be Arial.ttf then I use this lisp I uploaded earlier. In actual situation style names are similar AFTER $0$ not BEFORE exactly as the drawing I sent. So the style name with prefix shall be merged TO the one without prefix. then I have to purge all to remove the style name with prefix !

Thanks for your time pBe

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted
...I don't know about conditions cause i am new in lisp....

 

By conditions i meant the desired result nababeer, nothing to do with writing codes. As i've said, we here try to make the code as generic as possible.

 

Take a deep breath and think about the end result , its a simple case of what ifs / then / else... no coding involved, I'm trying to help you get a suitable solution here nababeer. be patient.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Try the following nababeer, I hope it helps:

 

([color=BLUE]defun[/color] c:mergedimtxt ( [color=BLUE]/[/color] cmd doc pos str )
   ([color=BLUE]setq[/color] doc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
   ([color=BLUE]foreach[/color] col '(textstyles dimstyles)
       (mergedimtxt:processcollection ([color=BLUE]vlax-get-property[/color] doc col))
   )
   ([color=BLUE]vlax-for[/color] blk ([color=BLUE]vla-get-blocks[/color] doc)
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=BLUE]:vlax-false[/color] ([color=BLUE]vla-get-isxref[/color] blk))
           ([color=BLUE]vlax-for[/color] obj blk
               ([color=BLUE]if[/color]
                   ([color=BLUE]and[/color]
                       ([color=BLUE]wcmatch[/color] ([color=BLUE]vla-get-objectname[/color] obj) [color=MAROON]"AcDb*Text,AcDb*Dimension"[/color])
                       ([color=BLUE]setq[/color] str ([color=BLUE]vla-get-stylename[/color] obj)
                             pos ([color=BLUE]vl-string-position[/color] 36 str [color=BLUE]nil[/color] [color=BLUE]t[/color])
                       )
                       ([color=BLUE]vlax-write-enabled-p[/color] obj)
                   )
                   ([color=BLUE]vla-put-stylename[/color] obj ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 2 pos)))
               )
           )
       )
   )
   ([color=BLUE]setq[/color] cmd ([color=BLUE]getvar[/color] 'cmdecho))
   ([color=BLUE]setvar[/color] 'cmdecho 0)
   ([color=BLUE]setvar[/color] 'textstyle [color=MAROON]"Standard"[/color])
   ([color=BLUE]command[/color] [color=MAROON]"_.-dimstyle"[/color] [color=MAROON]"_r"[/color] [color=MAROON]"Standard"[/color] [color=MAROON]"_.-purge"[/color] [color=MAROON]"_r"[/color] [color=MAROON]"*"[/color] [color=MAROON]"_n"[/color] [color=MAROON]"_.-purge"[/color] [color=MAROON]"_a"[/color] [color=MAROON]"*"[/color] [color=MAROON]"_n"[/color])
   ([color=BLUE]setvar[/color] 'cmdecho cmd)
   ([color=BLUE]vla-regen[/color] doc [color=BLUE]acallviewports[/color])
   ([color=BLUE]princ[/color])
)
([color=BLUE]defun[/color] mergedimtxt:processcollection ( col [color=BLUE]/[/color] pos str )
   ([color=BLUE]vlax-for[/color] obj col
       ([color=BLUE]if[/color]
           ([color=BLUE]and[/color]
               ([color=BLUE]setq[/color] str ([color=BLUE]vla-get-name[/color] obj)
                     pos ([color=BLUE]vl-string-position[/color] 36 str [color=BLUE]nil[/color] [color=BLUE]t[/color])
               )
               ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-item[/color] ([color=BLUE]list[/color] col ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 2 pos)))))
           )
           ([color=BLUE]vla-put-name[/color] obj ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 2 pos)))
       )
   )
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Link to comment
Share on other sites
nababeer Rookie

nababeer

Posted
  • Author
Posted
Try the following nababeer, I hope it helps:

 

([color=BLUE]defun[/color] c:mergedimtxt ( [color=BLUE]/[/color] cmd doc pos str )
   ([color=BLUE]setq[/color] doc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
   ([color=BLUE]foreach[/color] col '(textstyles dimstyles)
       (mergedimtxt:processcollection ([color=BLUE]vlax-get-property[/color] doc col))
   )
   ([color=BLUE]vlax-for[/color] blk ([color=BLUE]vla-get-blocks[/color] doc)
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=BLUE]:vlax-false[/color] ([color=BLUE]vla-get-isxref[/color] blk))
           ([color=BLUE]vlax-for[/color] obj blk
               ([color=BLUE]if[/color]
                   ([color=BLUE]and[/color]
                       ([color=BLUE]wcmatch[/color] ([color=BLUE]vla-get-objectname[/color] obj) [color=MAROON]"AcDb*Text,AcDb*Dimension"[/color])
                       ([color=BLUE]setq[/color] str ([color=BLUE]vla-get-stylename[/color] obj)
                             pos ([color=BLUE]vl-string-position[/color] 36 str [color=BLUE]nil[/color] [color=BLUE]t[/color])
                       )
                       ([color=BLUE]vlax-write-enabled-p[/color] obj)
                   )
                   ([color=BLUE]vla-put-stylename[/color] obj ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 2 pos)))
               )
           )
       )
   )
   ([color=BLUE]setq[/color] cmd ([color=BLUE]getvar[/color] 'cmdecho))
   ([color=BLUE]setvar[/color] 'cmdecho 0)
   ([color=BLUE]setvar[/color] 'textstyle [color=MAROON]"Standard"[/color])
   ([color=BLUE]command[/color] [color=MAROON]"_.-dimstyle"[/color] [color=MAROON]"_r"[/color] [color=MAROON]"Standard"[/color] [color=MAROON]"_.-purge"[/color] [color=MAROON]"_r"[/color] [color=MAROON]"*"[/color] [color=MAROON]"_n"[/color] [color=MAROON]"_.-purge"[/color] [color=MAROON]"_a"[/color] [color=MAROON]"*"[/color] [color=MAROON]"_n"[/color])
   ([color=BLUE]setvar[/color] 'cmdecho cmd)
   ([color=BLUE]vla-regen[/color] doc [color=BLUE]acallviewports[/color])
   ([color=BLUE]princ[/color])
)
([color=BLUE]defun[/color] mergedimtxt:processcollection ( col [color=BLUE]/[/color] pos str )
   ([color=BLUE]vlax-for[/color] obj col
       ([color=BLUE]if[/color]
           ([color=BLUE]and[/color]
               ([color=BLUE]setq[/color] str ([color=BLUE]vla-get-name[/color] obj)
                     pos ([color=BLUE]vl-string-position[/color] 36 str [color=BLUE]nil[/color] [color=BLUE]t[/color])
               )
               ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-item[/color] ([color=BLUE]list[/color] col ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 2 pos)))))
           )
           ([color=BLUE]vla-put-name[/color] obj ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 2 pos)))
       )
   )
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

 

Thanks a lot Lee :)

Should I run it from the other lisp RBP ? or run it individually ? Cause I ran it and it gives an error message referring Active X !

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Thanks a lot Lee :)

Should I run it from the other lisp RBP ? or run it individually ? Cause I ran it and it gives an error message referring Active X !

 

You're welcome.

You should be able to run it independently - what error message do you receive?

Link to comment
Share on other sites
nababeer Rookie

nababeer

Posted
  • Author
Posted
You're welcome.

You should be able to run it independently - what error message do you receive?

 

ActiveX server returned an error : type mismatch !

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
ActiveX server returned an error : type mismatch !

 

That's odd - I can't seem to replicate this error.

Does the error occur on every drawing that you test with the program?

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...