CoCreate User Forum  

Go Back   CoCreate User Forum > Support > Customization

 
 
Thread Tools Search this Thread Rating: Thread Rating: 3 votes, 5.00 average. Display Modes
Prev Previous Post   Next Post Next
  #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
 


Currently Active Users Viewing This Thread: 1 (0 members and 1 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 12:49 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: