Create two lists of strings, a

lamensterms · 发表于 2022-7-5 18:36:16

Hi guys,

I'm just in the very early stages of building a new LISP tool, so I'm not really sure of the best method to achieve the end result.

The plan is to have a LISP routine that will read data from different ProSteel elements and create a list of this data, then advise the user of the differences between the two lists.

For example, in a ProSteel 2D drawing, there will be 'steel' elements and 'part flag' elements. The 'steel' and 'part flag' elements both have a part number assigned to them. I would like to build a list of 'steel' part numbers & 'part flag' part numbers and compare them. Any 'steel' part numbers that are missing from the list of 'part flag' part numbers, will be returned to the user, and noted as missing from the drawing. I hope that explanation makes sense.

So to the code, I have routines that will read the part number data from the 'steel' & 'part flag' elements (and return strings) but I'm not sure how to build these strings into lists, and then compare them.

copy

(prompt "\nSelect ELEMENTS:")(setq ss (ssget '((0 . "KS*"))))(setq numtot (sslength ss))(setq con 0)(repeat numtot  (setq ent3A (ssname ss con))(setq ent3B ent3A)(setq acadapp (vlax-get-acad-object))(setq shapeinfo (vla-getinterfaceobject acadapp "PSCOMWRAPPER.Ks_ComShapeInfo"))    (vlax-invoke-method shapeinfo 'setobject  (vlax-ename->vla-object ent3A))(vlax-invoke-method shapeinfo 'getinfo)(setq shapeinfo (vla-getinterfaceobject acadApp "PSCOMWRAPPER.Ks_ComShape"))(setq shapeinfo (vlax-ename->vla-object ent3B))(setq PSptype (vlax-get-property shapeinfo 'ObjectName))  ;Part Type(setq PSpos (vlax-get-property shapeinfo 'PosNumber))  ;Part Number[color=red][b][i]if PSptype = steel, add PSpos to 'Steel List'if PSptype = partflag, add PSpos to 'Part Flag List'[/i][/b][/color] (vlax-release-object shapeinfo)   (setq shapeinfo nil)(setq acadApp nil)(princ)(setq con (1+ con)))[color=red][b][i]Check 'Part Flag List' against 'Steel List', if entries exist in 'Steel List' but not in 'Part Flag List' > Alert 'missing entries'.[/i][/b][/color]

I've added red text showing where I think I should add the extra functions, but I really don't know what I need to do.

I also am unsure if the method that I have conceived is, in fact, the best method to get this done. So any advice or suggestions are welcome.

Any assistance is greatly appreciated.

Thanks a lot.

BIGAL · 发表于 2022-7-5 19:16:57

A couple of suggestions use shapeinfo1 and shapeinfo2 and declare their interface at start . use a CONS to make list.

This is untested

copy

(setq acadapp (vlax-get-acad-object))(setq shapeinfo1 (vla-getinterfaceobject acadapp "PSCOMWRAPPER.Ks_ComShapeInfo"))(setq shapeinfo2 (vla-getinterfaceobject acadApp "PSCOMWRAPPER.Ks_ComShape"))(prompt "\nSelect ELEMENTS:")(setq ss (ssget '((0 . "KS*"))))(setq numtot (sslength ss))(setq con 0)(repeat numtot  (setq ent3A (ssname ss con))(setq ent3B ent3A)   (vlax-invoke-method shapeinfo1 'setobject  (vlax-ename->vla-object ent3A))(vlax-invoke-method shapeinfo1 'getinfo)(setq shapeinfo2 (vlax-ename->vla-object ent3B))(setq PSptype (vlax-get-property shapeinfo2 'ObjectName))  ;Part Type(setq PSpos (vlax-get-property shapeinfo2 'PosNumber))  ;Part Number;if PSptype = steel, add PSpos to 'Steel List';if PSptype = partflag, add PSpos to 'Part Flag List'(if (= psptype "steel")(setq steellist (cons PSpos steellist))) (if (= psptype "partflag")(setq partflag (cons PSpos partflaglst)));(vlax-release-object shapeinfo)   ;(setq shapeinfo nil);(setq acadApp nil)(princ)(setq con (1+ con)))(vlax-release-object shapeinfo1)(vlax-release-object shapeinfo2)   (setq num (length steellist)(setq num2 (length partflaglist)(setq x num)(setq y num2)(repeat Num(setq stl (nth (setq x (- x 1)))) ; returns items in 1st list(while (/= num2 y)(setq part (nth (setq y (- y 1)))) ; returns items in 2nd list(if (= part stl)(princ (strcat "Found " part " " stl))(setq y num2)))

lamensterms · 发表于 2022-7-5 20:04:10

Awesome, thanks for the reply BigAl.

I've used a combination of your suggestions mixed with some of Lee Mac's functions.

copy

(defun LM:lst->str ( lst del )    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)
 
 
(defun LM:ListDifference ( l1 l2 )
  (if l1
    (if (member (car l1) l2)
      (LM:ListDifference (cdr l1) l2)
      (cons (car l1) (LM:ListDifference (cdr l1) l2))
    )
  )
)
 
 
;; Unique  -  Lee Mac
;; Returns a list with duplicate elements removed.
 
(defun LM:Unique ( l / x r )
    (while l
        (setq x (car l)
              l (vl-remove x (cdr l))
              r (cons x r)
        )
    )
    (reverse r)
)
 
 
 
 
;;--------------------=={ String Subst }==--------------------;;
;;                                                            ;;
;;  Substitutes a string for all occurrences of another       ;;
;;  string within a string.                                   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  new - string to be substituted for 'old'                  ;;
;;  old - string to be replaced                               ;;
;;  str - the string to be searched                           ;;
;;------------------------------------------------------------;;
;;  Returns:  String with 'old' replaced with 'new'           ;;
;;------------------------------------------------------------;;
 
(defun LM:StringSubst ( new old str / inc len )
    (setq len (strlen new)
          inc 0
    )
    (while (setq inc (vl-string-search old str inc))
        (setq str (vl-string-subst new old str inc)
              inc (+ inc len)
        )
    )
    str
) 
 
 
 
 
 
(defun C[emoji14]spfc ( / steellist partflaglst)
 
(vl-load-com)
 
(setq acadapp (vlax-get-acad-object))
(setq shapeinfo1 (vla-getinterfaceobject acadapp "PSCOMWRAPPER.Ks_ComShapeInfo"))
(setq shapeinfo2 (vla-getinterfaceobject acadApp "PSCOMWRAPPER.Ks_ComShape"))
 
(prompt "\nSelect ELEMENTS:")
(setq ss (ssget '((0 . "KS*"))))
 
(setq numtot (sslength ss))
 
(setq con 0)
(repeat numtot  
(setq ent3A (ssname ss con))
(setq ent3B ent3A)
 
 
(vlax-invoke-method shapeinfo1 'setobject  (vlax-ename->vla-object ent3A))
(vlax-invoke-method shapeinfo1 'getinfo)
 
(setq shapeinfo2 (vlax-ename->vla-object ent3B))
 
(setq PSON (vlax-get-property shapeinfo2 'ObjectName))  ;Part Type
(setq PSpos (vlax-get-property shapeinfo2 'PosNumber))  ;Part Number
 
(cond 
((eq (strcase PSON) "KS_SHAPE") (setq steellist (cons PSpos steellist)))
((eq (strcase PSON) "KS_BENDSHAPE") (setq steellist (cons PSpos steellist)))
((eq (strcase PSON) "KS_ARCSHAPE") (setq steellist (cons PSpos steellist)))
((eq (strcase PSON) "KS_PLATE") (setq steellist (cons PSpos steellist)))
((eq (strcase PSON) "KS_BENDPLATE") (setq steellist (cons PSpos steellist)))
((eq (strcase PSON) "KS_ARCPLATE") (setq steellist (cons PSpos steellist)))
((eq (strcase PSON) "KS_POSFLAG") (setq partflaglst (cons PSpos partflaglst)))
)
 
(setq con (1+ con))
)
 
(vlax-release-object shapeinfo1)
(vlax-release-object shapeinfo2) 
 
(if (null steellist)
(progn (princ "\nNo Steel Selected...") (vl-exit-with-error ""))
)
 
(if (null partflaglst)
(progn (princ "\nNo Position Flags Selected...") (vl-exit-with-error ""))
)
 
(setq steellist (LM:Unique steellist))
(setq partflaglst (LM:Unique partflaglst))
 
(setq steellist (vl-sort steellist '

[编程交流] Create two lists of strings, a

发表回复

精选推荐