Jump to content
nababeer

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

Recommended Posts

nababeer

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)

)

Share this post


Link to post
Share on other sites
nababeer

Up ........................

Share this post


Link to post
Share on other sites
pBe

Lets make a deal. click on this linky first --->lmgtfy

 

If the solutions you find there doesn't really cut if for you then we here will have a look-see :)

Share this post


Link to post
Share on other sites
nababeer

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 !

Share this post


Link to post
Share on other sites
pBe
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

Share this post


Link to post
Share on other sites
nababeer

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)

)

Share this post


Link to post
Share on other sites
pBe

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.

Share this post


Link to post
Share on other sites
nababeer

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 :)

Share this post


Link to post
Share on other sites
pBe
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.

Share this post


Link to post
Share on other sites
nababeer

Both will be standard - Font :Arial

Share this post


Link to post
Share on other sites
pBe
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.

Share this post


Link to post
Share on other sites
nababeer

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

Share this post


Link to post
Share on other sites
pBe
...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.

Share this post


Link to post
Share on other sites
nababeer

That is the procedure as I think :

 

ax0bya.jpg

Share this post


Link to post
Share on other sites
Lee Mac

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])

Share this post


Link to post
Share on other sites
nababeer
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 !

Share this post


Link to post
Share on other sites
Lee Mac
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?

Share this post


Link to post
Share on other sites
nababeer
You're welcome.

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

 

ActiveX server returned an error : type mismatch !

Share this post


Link to post
Share on other sites
Lee Mac
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?

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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.


×
×
  • Create New...