Newsgroup: it.comp.software.cad
Titolo: [AutoCAD - VLisp] Ordinare stringhe, numeri o numeri e stringhe

Se qualcuno ha voglia di testare, la sequenza risultante
dovrebbe essere: numeri - MAIUSCOLE - minuscole
Ogni commento è benvenuto.
; Marc'Antonio Alessi 
http://xoomer.virgilio.it/alessi
;
; Function: ALE_List_SortAtoms
;
; Version 1.00 -    01/2005    (old name ALE_SortAlphaNum)
; Version 1.10 - 08/01/2007
;
; Example:
; (ALE_SortAlphaNum
;  '("C12" 99 01 "F2" "F3" "C4" "C2" "B34" "B2" "B12" 4 8 1 "z" 4 "hH2" "a1" 
"C12" "20C" "4R" "4C")
; )
; =>(1 1 4 4 8 99 "4C" "4R" "20C" "B2" "B12" "B34" "C2" "C4" "C12" "C12" "F2" 
"F3" "a1" "hH2" "z")
;
(defun ALE_List_SortAtoms (InpLst)
  (mapcar
   '(lambda (LmbDat) (nth LmbDat InpLst))
    (vl-sort-i InpLst
     '(lambda (LmbDt1 LmbDt2 / Num001 Num002)
        (setq
          Num001 (if (numberp LmbDt1) LmbDt1 (atoi LmbDt1))
          Num002 (if (numberp LmbDt2) LmbDt2 (atoi LmbDt2))
        )
        (cond
          ( (and (numberp LmbDt1) (numberp LmbDt2)) (< LmbDt1 LmbDt2) )
          ( (and (numberp LmbDt2) (not (numberp LmbDt1)))         nil )
          ( (and (numberp LmbDt1) (not (numberp LmbDt2)))             )
          ( (= Num001 Num002 0)
            (setq
              Num001 (atoi
                       (vl-string-translate
                         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                         "00000000000000000000000000"
                         (strcase LmbDt1)
                       )
                     )
              Num002 (atoi
                       (vl-string-translate
                         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                         "00000000000000000000000000"
                         (strcase LmbDt2)
                       )
                     )
              LmbDt1 (vl-string-translate "123456789" "000000000" LmbDt1)
              LmbDt2 (vl-string-translate "123456789" "000000000" LmbDt2)
            )
            (cond
              ( (and (= LmbDt1 LmbDt2) (< Num001 Num002)) )
              ( (< LmbDt1 LmbDt2) )
            )
          )
          ( (zerop Num001) nil )
          ( (zerop Num002) )
          ( (or (< Num001 Num002) (and (= Num001 Num002) (< LmbDt1 LmbDt2))) )
        )
      )
    )
  )
) 

 2D Parametric for 2000-2007 <
(strcat "I like " (substr (ver) 8 4) "!")
--
"Marco_AA" <Marco_AA@Marco_AA.com> ha scritto nel messaggio 
news:45a25a08$0$22391$4faf...@reader2.news.tin.it...


ciao Marco_AA 
il tuo lisp merita di essere pubblicizzato ;)
http://www.cad3d.it/forum1/showpost.php?p=100099&postcount=43
http://www.treddi.com/forum/index.php?showtopic=20787&st=50&gopid=323064&#
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

 il tuo lisp merita di essere pubblicizzato ;)
Mi sono dovuto iscrivere per scaricarlo...
Ciò che non mi piace è che la spaziatura dei testi è andata
persa e che alcuni ritorni a capo non sono corretti.
Bisognerebbe prevedere una lunghezza di riga di 80 caratteri.
Ecco le ultime versioni.
Ciao.
M.
;
; Marc'Antonio Alessi - 
http://xoomer.virgilio.it/alessi
; Function: ALE_DelXdataSs
;
; Version 1.01 - 08/04/2003
; Version 1.02 - 01/06/2006
; Version 1.03 - 15/06/2006
;
; Description: delete XData of specified APPID(s)
;
; Arguments:
;   ApsLst = AppID's list
;   BitFlg && 1 prompts ON
;          && 2 erase Xdata on all objects else by selection
;
; Examples:
;   (ALE_DelXdataSs '("MyApp1" "MyApp2") 1)
;   > delete by AppID's and by selection
;   or
;   (ALE_DelXdataSs '("*") 3)
;   > delete all xdata of all AppID's from all objects
;
; Comments:
;   The filter in ssget is not useful, because in case of a block with
;   Attribute Xdata only, it doesn't work.
;   The argument of the function should be a list. This allows you to
;   delete Xdata's with different AppID's.
;
(defun ALE_DelXdataSs (ApsLst BitFlg / SsXdat ApsStr EntNam EntDat Countr)
  (setq ApsStr "")
  (foreach AppNam ApsLst
    (setq ApsStr (strcat ApsStr "," AppNam))
  )
  (if (= 2 (logand 2 BitFlg))
    (setq SsXdat (ssget "_X" (list (list -3 (list (substr ApsStr 2))))))
    (setq SsXdat (ssget      (list (list -3 (list (substr ApsStr 2))))))
  )
  (cond
    ( SsXdat
      (repeat (setq Countr (sslength SsXdat))
        (setq
          Countr (1- Countr)
          EntNam (ssname SsXdat Countr)
          EntDat (entget EntNam ApsLst)
        )
        (ALE_DelXdataEnt EntNam EntDat)
        (and
          (= "INSERT" (DXF 0 EntDat))
          (= 1 (DXF 66 EntDat))
          (while
            (and
              (setq EntNam (entnext EntNam))
              (= "ATTRIB" (DXF 0 (setq EntDat (entget EntNam ApsLst))))
            )
            (ALE_DelXdataEnt EntNam EntDat)
          )
        )
      );repeat
      (and (= 1 (logand 1 BitFlg)) (princ "\nEliminazione Xdata eseguita.  "))
    )
    ( (= 1 (logand 1 BitFlg))
      (princ "\nNon è stato trovato nessun oggetto con Xdata.  ")
    )
  )
)
;
; Marc'Antonio Alessi - 
http://xoomer.virgilio.it/alessi
; Function: ALE_DelXdataSs
;
; Example: (ALE_DelXdataEnt ename '("MyApp1" "MyApp2"))
;
; In AutoCAD 14 Xdata on dimension entities will be not erased if they are
; substituted with an empty list when there are no Xdata of another
; application, see AND condition.
;
(defun ALE_DelXdataEnt (EntNam EntDat / TmpLst)
; (and
;   (= 14 (atoi (getvar "ACADVER")))
;   (eq "DIMENSION" (DXF 0 EntDat))
;   (not (DXF -3 (entget EntNam '("ACAD"))))
;   (entmod (list (cons -1 EntNam) '(-3 ("ACAD" (1000 . "DSTYLE")))))
; )
  (foreach ForElm (DXF -3 EntDat)
    (setq TmpLst (cons (list (car ForElm)) TmpLst))
  )
  (entmod (list (cons -1 EntNam) (cons -3 TmpLst)))
)
;
; For single AppName (Doug Broad)
;
; Example: (ALE_DelXdata1AppEnt ename "MyApp1")
;
(defun ALE_DelXdata1AppEnt (EntNam AppNam)
  (entmod (list (cons -1 EntNam) (list -3 (list AppNam))))
)
;
; Marc'Antonio Alessi - 
http://xoomer.virgilio.it/alessi
; Function: ALE_RenAppid
;
(defun ALE_RenAppid (OldNam NewNam / EntNam VlaObj)
; (vl-load-com)
  (and
    (not (tblsearch "APPID" NewNam))
    (setq EntNam (tblobjname "APPID" OldNam))
    (setq VlaObj (vlax-ename->vla-object EntNam))
    (not (vlax-put-property VlaObj 'Name NewNam))
    (vlax-release-object VlaObj)
  )
)
;
; Marc'Antonio Alessi - 
http://xoomer.virgilio.it/alessi
; Function: ALE_PurgeAppids
;
; TrueFl = T > prompt ON - if ON return last prompt else return ApsLst
;
(defun ALE_PurgeAppids (TrueFl / AppNam ApsLst)
 ;(vl-load-com)
 ;(or *AcadApp* (setq *AcadApp* (vlax-get-acad-object)))
 ;(or *AcAcDwg* (setq *AcAcDwg* (vla-get-ActiveDocument *AcadApp*)))
  (vlax-for ObjFor (vla-get-registeredapplications *AcAcDwg*)
    (setq AppNam (vla-get-name ObjFor))
    (or
      (vl-catch-all-apply 'vla-delete (list ObjFor))
      (setq ApsLst (cons AppNam ApsLst))
    )
  )
  (if (and ApsLst TrueFl)
    (foreach AppNam ApsLst
      (princ (strcat "\nL'applicazione: " AppNam " è stata eliminata.  "))
    )
    ApsLst
  )
)

Chiedo scusa, qualche ritocco per velocizzare:
; Marc'Antonio Alessi 
http://xoomer.virgilio.it/alessi
;
; Function: ALE_List_SortAtoms
;
; Version 1.00 -    01/2005    (old name ALE_SortAlphaNum)
; Version 1.13 - 24/01/2007

              (setq Flg001 (numberp LmbDt1)  Flg002 (numberp LmbDt2))
              Flg001
            )
            (< LmbDt1 LmbDt2)
          )
          ( (and Flg002 (not Flg001)) nil )
          ( Flg001 )
          ( (=
              (setq Num001 (if Flg001 LmbDt1 (atof LmbDt1)))
              (setq Num002 (if Flg002 LmbDt2 (atof LmbDt2)))
              0
            )
            (setq
              Num001 (atof
                       (vl-string-translate
                         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                         "00000000000000000000000000"
                         (strcase LmbDt1)
                       )
                     )
              Num002 (atof
                       (vl-string-translate
                         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                         "00000000000000000000000000"
                         (strcase LmbDt2)
                       )
                     )
              LmbDt1 (vl-string-translate "123456789" "000000000" LmbDt1)
              LmbDt2 (vl-string-translate "123456789" "000000000" LmbDt2)
            )
            (cond
              ( (and (= LmbDt1 LmbDt2) (< Num001 Num002)) )
              ( (< LmbDt1 LmbDt2) )


grazie Marco ;)


dal momento che ti sei registrato,
quando hai qualche novità che vuoi divulgare,
inserisci i file direttamente in TREDDI
così non si perdono gli spazi
ciao ;)


 così non si perdono gli spazi
Mi trovo meglio con OutLook E. a seguire le varie discussioni
anche perchè è più veloce visto che qui la Telecom non vuole
far arrivare l'ADSL  :-(
..
Mi sono dimenticato (come al solito) di:
(defun Dxf (DxfCod EntDat)
  (cdr (assoc DxfCod EntDat))
)
Ti piace il mio indirizzo e-mail criptato?
-- 
Marc'Antonio Alessi
(vl-string-translate "1234567890" "i...@mst.lan" "499825513610716")


 Ti piace il mio indirizzo e-mail criptato?
degno del mago del vlisp ;)
ciao


l'ho inserito qui
ciao
http://www.cad3d.it/forum1/showpost.php?p=107872&postcount=6


 ha scritto nel messaggio 
news:esj5q5$at9$1...@news.newsland.it...


 RiCiao.
ciao Marco, 
se vuoi puoi postarlo qui il lisp per portare la Z a 0 degli oggetti
nidificati nei blocchi senza esploderli.
poi diffondo il link sugli altri forum


 nidificati nei blocchi senza esploderli.
Ti ho rispoto in privato.