[编程交流] LISP列表搜索

'(("150 mm PVC PIPE" 150.0) ("250 mm PVC PIPE" 250.0))

(setq listPipes '(("150 mm PVC PIPE" 0.0) ("250 mm PVC PIPE" 0.0)))
(if (setq subList (assoc "150 mm PVC PIPE" listPipes))
(setq listPipes (subst (list (car subList) (+ (cadr subList) 150.0))
                       subList
                       listPipes)
)
)

(defun c:test
      (/          ANS             n                sset           count
       check          item             test        2dl           psn
       size_arrary             list_counter           tester
       check2          pipe_size_list        check3
      )
 (vl-load-com)
 (setq test 0)                                ; tester
 (setq n 0)                                ;loop counter
 (setq list_counter 0)                        ;list counter
 (setq part_size_list nil)
 (PRINC "SELECT ALL OR MANUAL...")
 (PRINC)
 (INITGET 2 "ALL MANUAL")
 (SETQ ANS (GETKWORD "(A)LL (M)ANUAL)"))
 (IF                                        ; CHECK ANSWER FOR SELECTION ALL
   (= ANS "ALL")
    (PROGN
      (setq sset (ssget "X"))                ;selection set
      (setq count (sslength sset))        ;total number of selection set
    )                                        ;END PROGN
 )                                        ;END IF - ALL
 (IF                                        ; CHECK ANSWER FOR SELECTION ALL
   (= ANS "MANUAL")
    (PROGN
      (setq sset (ssget))                ;selection set
      (setq count (sslength sset))        ;total number of selection set
    )                                        ;END PROGN
 )                                        ;END IF - MANUAL
 (while
   (< n count)                                ;while logic statement
    (setq item (ssname sset n))        ;get item from selection set
    (setq item (vlax-ename->vla-object item))
    (setq check (vlax-get-property item 'objectname))
    (if                                ;check to see if pipe
      (= check "AeccDbPipe")                ;if logic statement for pipe
(progn                                ; starts comppiling
  (setq psn (vlax-get-property item 'PartSizeName))
  (setq part_size_list (append part_size_list (list psn)))
)                                ;end progn
    )                                        ;end if
    (setq n (+ 1 n))                        ; increase loop counter
 )                                        ;end while
 (foreach x part_size_list
   (if        (not (vl-position x myList))
     (setq myList (cons x myList))
   )
 )
 (reverse myList)
    
 
 (princ)
 (alert
   (strcat "Total length of selected objects is " (rtos test))
 )                                        ;report pipe length
 (princ part_size_list)
 (princ MYLIST)
)

;;; Dump all methods and properties for selected objects              ;
;;;===================================================================; 
;;; DumpIt                                                            ; 
;;;-------------------------------------------------------------------; 
;;;===================================================================; 
(defun C:DumpIt ( / ent) 
 (while (setq ent (entsel)) 
   (vlax-Dump-Object 
     (vlax-Ename->Vla-Object (car ent)) T
   ) 
 ) 
 (princ) 
)