CoCreate User Forum  

Go Back   CoCreate User Forum > Support > Customization

Reply
 
Thread Tools Search this Thread Rating: Thread Rating: 3 votes, 5.00 average. Display Modes
  #1  
Old 08-01-2014, 04:31 PM
dan_canfield dan_canfield is offline
Registered User
 
Join Date: Feb 2003
Location: McMinnville, OR
Posts: 12
Broken LISP in v18.1

We have a LISP routine we have been using to rename multiple instances of shared parts (based on one shared here: http://www.cocreateusers.org/forum/showthread.php?t=6425). It worked well in version 17, but doesn't seem to work in version 18.1. No dialog shows up in the toolbox in 18.1.

Code:
(in-package :custom)
(use-package :OLI)
;;--------------------------------------------------------------------------*
(sd-defdialog 'Rename_shared_parts
:dialog-title "Change names of Parts/Assemblies"
;;:dialog-control :sequential
:variables
'(
(alle
:initial-value t)
(csids)
(wahl
:selection
(*sd-object-seltype*)
:multiple-items t
:prompt-text "Select Part or Assembly to Rename"
:title "Select Part/Assy"
:initial-value nil
)
(cust :value-type :string
:title "New Name:"
:toggle-type :indicator-toggle-data
:initial-value nil
)
(ol :value-type :boolean
:toggle-type :wide-toggle
:title "One level"
:initial-value t
)
)
:mutual-exclusion '((cust))
:local-functions
'(
(after-nur-action ()
(let (kind csid)
(dolist (kind nur)
(setf csid (sd-inq-obj-contents-sysid kind))
(push csid csids)
);;dolist
)
)
(next-action ()
(let ()
(dolist (kind wahl)
(dc4-mminfo-to-basename-in-bgr kind alle     cust csids ol)
);;dolist
)
)
)
:ok-action
'(sd-call-cmds (next-action))
)
(defun dc4-mminfo-to-basename-in-bgr (teil_bgr alle     cust csids ol)
(let (basename owner pathname mminfo basename newpath kind kinder csid)
(setf basename (sd-inq-obj-basename teil_bgr))
(setf csid (sd-inq-obj-contents-sysid teil_bgr))
(when (or (sd-inq-part-p teil_bgr)
(sd-inq-assembly-p teil_bgr)
(sd-inq-container-p teil_bgr)
)
(progn
(setf pathname (sd-inq-obj-pathname teil_bgr))
(when (sd-string/= pathname "/")
(progn
(cond
(
(setf mminfo (sd-inq-obj-contents-name teil_bgr))
)
(
(setf mminfo (dc4-desman-get-codice teil_bgr))
)
(
(setf mminfo (dc4-desman-get-benennung-info teil_bgr))
)
(
(setf mminfo (dc4-desman-get-codice-descrizione teil_bgr))
)
(cust
(setf mminfo cust)
)
(t
(setf mminfo (sd-inq-obj-contents-name teil_bgr))
)
);;if
(setf owner (sd-inq-parent-obj teil_bgr))
(when (not owner)
(setf owner (sd-pathname-to-obj "/"))
);;when
(when mminfo
(progn
(setf newname (dc4-gen-part-basename owner teil_bgr mminfo))
(when (or (and (sd-inq-part-p teil_bgr) (sd-string-match-pattern-p "[tT][0-9]*" basename))
(and (sd-inq-assembly-p teil_bgr) (sd-string-match-pattern-p "[bB][0-9]*" basename))
(and (sd-inq-container-p teil_bgr) (sd-string-match-pattern-p "[bB][hH][0-9]*" basename))
alle
)
(if csids
(progn
(when (member csid csids :test #'equal)
(progn
(if (not (sd-inq-obj-parent-contents-read-only-p teil_bgr))
(sd-call-cmds (CHANGE_NAME_PA :PART_ASMB pathname :NAME newname))
;; (display (format nil "~a La Parte/Gruppo non puo' essere rinominata" pathname))
);;if
);;progn
);;when
);;progn
(progn
(if (not (sd-inq-obj-parent-contents-read-only-p teil_bgr))
(sd-call-cmds (CHANGE_NAME_PA :PART_ASMB pathname :NAME newname))
;; (display (format nil "~a La Parte/Gruppo non puo' essere rinominata" pathname))
);;if
);;progn
);;if
);;when
);;progn
);;when
);;progn
);;when
(when (not ol)
(progn
(setf kinder (sd-inq-obj-children teil_bgr))
(dolist (kind kinder)
(dc4-mminfo-to-basename-in-bgr kind alle   cust csids ol)
) ;; dolist
);;progn
);;when
);;progn
);;when
) ;; let
)
(defun dc4-gen-part-basename (owner teil_bgr prefix)
(let (baslist chlist ch teiletyp bas index name)
(setf baslist (list))
(setf chlist (sd-inq-obj-children owner))
(dolist (ch chlist)
(when (or (sd-inq-part-p ch) (sd-inq-assembly-p ch) (sd-inq-container-p ch))
(progn
(when (not (equal ch teil_bgr))
(progn
(setf bas (sd-inq-obj-basename ch))
(setf baslist (nconc baslist (list bas)))
);;progn
);;when
);;progn
);;when
);;dolist
(setf index 0)
(loop
(setf index (+ index 1))
;(if (= digt 1) ;DC trying to implement digit choice
;(setf name (format nil "~a_~10,1,'0,'0r" prefix index)) ;DC trying to implement digit choice
(setf name (format nil "~a_~10,2,'0,'0r" prefix index))
;);;if
(if (not (member name baslist :test #'equal)) (return t))
);;loop
(values name)
);;let
)
(defun dc4-desman-get-benennung-info (teil)
(let (attributliste attribut inf)
(setf attributliste (sd-inq-item-attributes teil :attachment :contents))
(setf inf nil)
(dolist (attribut attributliste)
(progn
(when (string= attribut "DB-PREF")
(progn
(setq inf (sd-inq-item-attribute teil attribut :DESCRIZIONE :attachment :contents))
(setf inf (sd-string-replace inf " " "_"))
(setf inf (sd-string-replace inf "=" "_"))
(setf inf (sd-string-replace inf "," "."))
(setf inf (sd-string-replace inf "X" "x")) 
(setf inf (sd-string-replace inf "._" "_"))
);;progn
);;when
);;progn
);;dolist
(when (typep inf 'STRING)
(when (= (length inf) 0) (setf inf nil))
);;when
(values inf)
);;let
)
(defun dc4-desman-get-codice (teil)
(let (attributliste attribut inf)
(setf attributliste (sd-inq-item-attributes teil :attachment :contents))
(setf inf nil)
(dolist (attribut attributliste)
(progn
(when (string= attribut "DB-PREF")
(progn
(setq inf (sd-inq-item-attribute teil attribut :CODICE :attachment :contents))
);;progn
);;when
);;progn
);;dolist
(when (typep inf 'STRING)
(when (= (length inf) 0) (setf inf nil))
);;when
(values inf)
);;let
)
(defun dc4-desman-get-codice-descrizione (teil)
(let (attributliste attribut inf)
(setf attributliste (sd-inq-item-attributes teil :attachment :contents))
(setf inf nil)
(setf infcodice nil)
(dolist (attribut attributliste)
(progn
(when (string= attribut "DB-PREF")
(progn
(setq infcodice (sd-inq-item-attribute teil attribut :CODICE :attachment :contents))
(setq inf (sd-inq-item-attribute teil attribut : DESCRIZIONE :attachment :contents))
(setf inf (sd-string-replace inf " " "_"))
(setf inf (sd-string-replace inf "=" "_"))
(setf inf (sd-string-replace inf "," "."))
(setf inf (sd-string-replace inf "X" "x")) 
(setf inf (sd-string-replace inf "._" "_"))
(setf inf (format nil "~a_~a" infcodice inf ))
);;progn
);;when
);;progn
);;dolist
(when (typep inf 'STRING)
(when (= (length inf) 0) (setf inf nil))
);;when
(values inf)
);;let
)
Anybody have a clue why this stopped working?

Thanks!
__________________
Dan Canfield
Mechanical Engineering and Product Design
Andrews Cooper Technology, Inc.


Reply With Quote
  #2  
Old 08-01-2014, 10:38 PM
Friedly's Avatar
Friedly Friedly is offline
Registered User
 
Join Date: May 2012
Location: Belgium
Posts: 76
Re: Broken LISP in v18.1

Hi Dan,
you have only to ad the line ":toolbox-button t" in your Lisp

:dialog-title "Change names of Parts/Assemblies"
:toolbox-button t
;;:dialog-control :sequential
Reply With Quote
  #3  
Old 08-05-2014, 01:27 PM
dan_canfield dan_canfield is offline
Registered User
 
Join Date: Feb 2003
Location: McMinnville, OR
Posts: 12
Re: Broken LISP in v18.1

Quote:
Originally Posted by Friedly View Post
Hi Dan,
you have only to ad the line ":toolbox-button t" in your Lisp

:dialog-title "Change names of Parts/Assemblies"
:toolbox-button t
;;:dialog-control :sequential
That did it! Thanks very much!!
__________________
Dan Canfield
Mechanical Engineering and Product Design
Andrews Cooper Technology, Inc.


Reply With Quote
  #4  
Old 08-05-2014, 10:13 PM
Andy Poulsen Andy Poulsen is offline
Administrator
 
Join Date: Apr 2003
Location: Fort Collins, Colorado
Posts: 273
Re: Broken LISP in v18.1

Yeah, that was a change that broke a LOT of code -- I know many people (including me!) who were really confused when they made that change!

Glad it was a simple fix!
__________________
Andy Poulsen
AI MAXTools: Dream. Design. Done. It's that easy!
Add-ins bringing new functionality and speed to Creo Elements/Direct and CoCreate products. Now available for v17-v20+!
See them in action at www.ai-maxtools.com and then try them for yourself -- FREE!
Reply With Quote
  #5  
Old 08-16-2015, 06:42 AM
Friedly's Avatar
Friedly Friedly is offline
Registered User
 
Join Date: May 2012
Location: Belgium
Posts: 76
Re: Broken LISP in v18.1

Hello there,
have a question / request to the Lisp specialists.
When using this Lisps It is necessary to select all the required shared parts individually.
If the parts are Spread over various assemblies and far from each other this is laborious work.
Is it possible to choose only one of the shared parts and the lisp finds all other automatically?
Reply With Quote
  #6  
Old 08-17-2015, 01:03 AM
jkramer's Avatar
jkramer jkramer is offline
Registered User
 
Join Date: Oct 2002
Location: the Netherlands
Posts: 382
Re: Broken LISP in v18.1

Yes this can be done, but it takes some work. One possible solution is to put the Sys ID's of the selected parts in a hash table, and when you push the ok-button, the lisp routine should walk along your complete assy, and gather all parts with the chosen Sys ID's. Using a hash table with the Sys Id's as key values speeds up things nicely :-)

Regards,
Jaap
Reply With Quote
  #7  
Old 08-17-2015, 08:27 AM
Friedly's Avatar
Friedly Friedly is offline
Registered User
 
Join Date: May 2012
Location: Belgium
Posts: 76
Re: Broken LISP in v18.1

Hello Jaap,

thanks for your answer, unfortunately it does not help me much further because I only can look at Lisp but can not write .
I am in need of help.

On the site where the renaming Lisp is coming from, there is another Lisp which exchanges shared parts.
This has the possibility to update all copies without individual selection.
If you want to check it out:
http://osd.cad.de/lisp_3d_40.htm
Look for "replace_parts.lsp"

You have a choice of only one, all or selection.


Bedankt voorbaat Jaap
Attached Files
File Type: lsp replace_parts.lsp (6.1 KB, 574 views)
Reply With Quote
  #8  
Old 08-17-2015, 11:09 PM
jkramer's Avatar
jkramer jkramer is offline
Registered User
 
Join Date: Oct 2002
Location: the Netherlands
Posts: 382
Re: Broken LISP in v18.1

Hi,

I made a "Rename All Shares" years ago, is this what you are looking for??
The field "Assembly" is the main assy in which you want to do your rename acgtion, "Part/Assy" is the part or assy that you want to rename. "Basename" is the new name for this Part/Assy. All shares of the Part/Assy will also be renamed.
Code:
(in-package :JAAPS_TOOLS)
(use-package :OLI)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(sd-defdialog 'rename_all_shares
 
 	:dialog-title "Rename All Shares"
	:toolbox-button t
  
	:variables
 	'(
		(ASSY :value-type :assembly :modifies :nil :title "Assembly" :initial-value (sd-pathname-to-obj "/"))
		(PARTASSY :selection (*sd-part-seltype* *sd-assembly-seltype*) :title "Part/Assy" :modifies NIL)
		(basename :value-type :string :title "New Base Name" :initial-value NIL)
 	)

 	:local-functions
  	'(
   		(doit ()
			;inquire sysid of the selected part/assy
			(setf sysid (sd-inq-obj-contents-sysid partassy))
			;get a list of all items below the assy
			(setf TOT (jb-inq-obj-tree-list assy))
			;process all these items
			(dolist (obj TOT "done")
				;check if the current item is a share of the selected part/assy
				(if (equal (sd-inq-obj-contents-sysid obj) sysid)
				;if so, rename it
				(progn
				;(display (format nil "Found: ~a" (sd-inq-obj-pathname obj)))
				;find the parent assy
				(if (sd-inq-parent-obj obj) (setf parntpath (sd-inq-obj-pathname (sd-inq-parent-obj obj))) (setf parntpath ""))
				;create the name
				(setf pth (format nil "~a/~a" parntpath basename))
				(setf suggestedpath pth)
				(setf countr 1)
				(setf basename2 basename)
				;if the pathname already exists, we should add a postfix number
				(if (oli::sd-pathname-to-obj pth) 
				(progn
					(setf goed 0)
					;loop until we find a non-existing pathname
					(loop while (equal goed 0) do
					(setf pth (format nil "~a.~a" suggestedpath countr))
					(if (oli::sd-pathname-to-obj pth) 
					(progn
					(setf countr (+ countr 1))
					)
					(progn
					(setf goed 1)
					);progn
					);endif
					);endloop
					;do the actual rename
					(setf basename2 (format nil "~a.~a" basename2 countr))
					(change_name_pa :part_asmb obj :name basename2)
				);progn
				(change_name_pa :part_asmb obj :name basename)
				);endif
				);progn
				());endif
			);dolist
		);doit
	)
  
	 
	:ok-action 
	'(doit)
)

(defun jb-inq-obj-tree-list (obj)
  	(cons obj
   		(apply #'nconc 
			(mapcar #'jb-inq-obj-tree-list 
				(sd-inq-obj-children obj)
			)
		)
	)
)
Regards,
Jaap
Reply With Quote
  #9  
Old 08-21-2015, 08:41 AM
Friedly's Avatar
Friedly Friedly is offline
Registered User
 
Join Date: May 2012
Location: Belgium
Posts: 76
Thumbs up Re: Broken LISP in v18.1

Hello Jaap,
Thanks, that works excellent.
Why write something new when the program is already in place.
Groot BEDANKT uit Belgie
Friedhelm
Reply With Quote
  #10  
Old 07-10-2018, 01:21 PM
Kaji Kaji is offline
Registered User
 
Join Date: Mar 2006
Posts: 19
Re: Broken LISP in v18.1

Is it the same for this lisp?

Code:
;;--------------------------------------------------------------------------*
;;  Copyright 2013  IWG                                                     *
;;                                                                          *
;;--------------------------------------------------------------------------*
(in-package :custom)
(use-package :OLI)
;;--------------------------------------------------------------------------*
(sd-defdialog 'iwg-teil-mehrfach-eigenstaendig-dialog
:dialog-title "Mehrfach Eigenstaendig"
;;:dialog-control :sequential
:precondition '(if (sd-inq-active-configuration)
                                                                (values :error "Achtung, Konfiguration aktiv!")
                :ok)
:variables
  '(
    ;;local
                (good)
    ;;dialog
    (teil  :selection
              (*sd-object-seltype*)
           :multiple-items t
           :show-select-menu t
                                            :incremental-selection t ;;:on-non-empty-list 
                                            :modifies :parent-contents
           :prompt-text "Teile oder Baugruppen angeben"
           :title "Teil/Bgr"
           :after-input (check-it)
    )
    (ol    :value-type :boolean
           :toggle-type :wide-toggle
           :title "Eine Ebene"
           :initial-value t
    )
    (next
           :push-action (sd-call-cmds (next-action))
    )
   )
:local-functions
  '(
    (check-it ()
     (let (good primus exlist sel exlist primus restlist)
      (setf good t)
      (setf primus (car teil))
      (setf restlist (cdr teil))
      (setf exlist (sd-inq-obj-shared-objects primus :all t))
      (dolist (sel restlist)
       (when (not (find sel exlist :test #'equal))
        (setf good nil)
       );;when 
      );;dolist
      (when (not good)
       (progn
        (sd-display-error "Nicht alle ausgewaehlten Teile sind Exemplare voneinander!")
        (setf teil nil)
       );;progn
      );;when
     );;let
    )
                (next-action ()
     (let (olus primus exlist sel exlist primus et restlist por pz px lor lz lx bgr assy prt altname)
                        (if ol (setf olus :on) (setf olus :off))
      (setf primus (car teil))
      (setf restlist (cdr teil))
      (setf exlist (sd-inq-obj-shared-objects primus :all t))
      (setf por (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 0) :source-space primus :dest-space :global))
      (setf pz (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 1) :source-space primus :dest-space :global))
      (setf px (sd-vec-xform (make-gpnt3d :x 1 :y 0 :z 0) :source-space primus :dest-space :global))
      (setf bgr (sd-inq-parent-obj primus))
                        (if bgr
                            (setf assy (sd-inq-obj-pathname bgr))
                            (setf assy "/")
                        );;if
      (setf prt (sd-inq-obj-pathname primus))
                        (sd-call-cmds (pa_unshare :source prt :onelevel olus))
                        (setf vari (sd-pathname-to-obj prt))
      (dolist (et restlist)
       (setf lor (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 0) :source-space et :dest-space :global))
       (setf lz (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 1) :source-space et :dest-space :global))
       (setf lx (sd-vec-xform (make-gpnt3d :x 1 :y 0 :z 0) :source-space et :dest-space :global))
       (setf altname (sd-inq-obj-basename et))
       (setf bgr (sd-inq-parent-obj et))
       (setf assy (sd-inq-obj-pathname bgr))
       (delete_3d (sd-inq-obj-pathname et))
       (sd-call-cmds (create_multiple_pa :share
                     :owner assy
                     :name altname
                     :source prt
                     :keep_attr :on
                     :match_three_pts por lor px lx pz lz
                     )
       )
      );;dolist
     );;let
    )
   )
:ok-action '(next-action)
)
Thanks
Reply With Quote
  #11  
Old 07-11-2018, 10:10 AM
Andy Poulsen Andy Poulsen is offline
Administrator
 
Join Date: Apr 2003
Location: Fort Collins, Colorado
Posts: 273
Re: Broken LISP in v18.1

Yes, you will need to add ":toolbox-button t" (without the quotation marks) to the top of your dialog if you want the button to appear in the toolbox.

So the top of your dialog definition could look like:
Code:
(sd-defdialog 'iwg-teil-mehrfach-eigenstaendig-dialog
  :dialog-title "Mehrfach Eigenstaendig"
  :toolbox-button t
  ;;:dialog-control :sequential
...
Does that help?
__________________
Andy Poulsen
AI MAXTools: Dream. Design. Done. It's that easy!
Add-ins bringing new functionality and speed to Creo Elements/Direct and CoCreate products. Now available for v17-v20+!
See them in action at www.ai-maxtools.com and then try them for yourself -- FREE!
Reply With Quote
  #12  
Old 07-11-2018, 01:03 PM
Kaji Kaji is offline
Registered User
 
Join Date: Mar 2006
Posts: 19
Re: Broken LISP in v18.1

Quote:
Originally Posted by Andy Poulsen View Post
Does that help?
Yes. it works
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 2 (0 members and 2 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT -8. The time now is 01:12 PM.



Hosted by SureServer    Forums   Modeling FAQ   Macro Site   Vendor/Contractors   Software Resellers   CoCreate   Gallery   Home   Board Members   Regional User Groups  By-Laws  

Powered by vBulletin® Version 3.8.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
You Rated this Thread: