CoCreate User Forum

CoCreate User Forum (https://www.cocreateusers.org/forum/index.php)
-   Customization (https://www.cocreateusers.org/forum/forumdisplay.php?f=12)
-   -   Broken LISP in v18.1 (https://www.cocreateusers.org/forum/showthread.php?t=8160)

dan_canfield 08-01-2014 04:31 PM

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!

Friedly 08-01-2014 10:38 PM

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

dan_canfield 08-05-2014 01:27 PM

Re: Broken LISP in v18.1
 
Quote:

Originally Posted by Friedly (Post 25651)
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!!

Andy Poulsen 08-05-2014 10:13 PM

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!

Friedly 08-16-2015 06:42 AM

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?

jkramer 08-17-2015 01:03 AM

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

Friedly 08-17-2015 08:27 AM

Re: Broken LISP in v18.1
 
1 Attachment(s)
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 :rolleyes:.
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.
http://ww3.cad.de/foren/ubb/uploads/friedhelm+at+work/Teile-Bgrtauschen.jpg

Bedankt voorbaat Jaap :)

jkramer 08-17-2015 11:09 PM

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

Friedly 08-21-2015 08:41 AM

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

Kaji 07-10-2018 01:21 PM

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

Andy Poulsen 07-11-2018 10:10 AM

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?

Kaji 07-11-2018 01:03 PM

Re: Broken LISP in v18.1
 
Quote:

Originally Posted by Andy Poulsen (Post 26125)
Does that help?

Yes. it works


All times are GMT -8. The time now is 04:47 AM.

Powered by vBulletin® Version 3.8.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.