修改块属性Lisp
你好一段时间前，LeeMac为我编写了一个Lisp，用于从文本文件更新块attribs。块属性是项目名称和项目编号。来自文本文件中的同一行，因此该行如下所示：
L4535 Joe Bloggs道路改善方案。因此，TAG1 attrib变为“L4535 Joe Bloggs道路改善方案”，TAG2变为“L4535”。我想修改它，使TAG1在第一个空格之后成为一切，而TAG2保持原样。我不得不自己修改它很多次，但我迷失在其中。
如果有人能就此停下来，我将不胜感激。
谢谢
project_names : dialog { key = "dctitle";
spacer;
: list_box { label = "Choose a project name:"; key = "lst";
alignment = centered; fixed_height = true;
fixed_width = true; width = 60; height = 20; }
spacer;
ok_cancel;
}
(defun c:project_names (/ *error* _read
BLOCKNAME
DCFILENAME DCFLAG DCTAG
ELST ENT I POS PTR SS STR
STRFILENAME STRLST TAGSTRING TAGSTRING1 TAGSTRING2
)
(vl-load-com)
;; Lee Mac~01.03.10
(setq dcfilename"project_names.dcl" ;; DCL Filename
Strfilename "CCC_NNRDO_Project_Names.txt" ;; Data Filename
BlockName "CCC_Project_Names" ;; Block Name
TagString1"TAG1" ;; Tag String
TagString2"TAG2" ;; Tag String
)
(defun *error* (msg)
(and dcTag (unload_dialog dcTag))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(defun _read (file / ofile lst nl)
(cond ((setq ofile (open file "r"))
(while (setq nl (read-line ofile))
(setq lst (cons nl lst)))
(close ofile)))
(reverse lst))
(cond ((not (setq i -1 ss (ssget "_X" (list (cons 0 "INSERT")
(cons 2 BlockName) (cons 66 1)))))
(princ (strcat "\n** No Blocks with Name: " BlockName " Found **")))
((not (setq Strfilename (findfile Strfilename)))
(princ "\n** Data File not Found **"))
((not (setq StrLst (_read Strfilename)))
(princ "\n** Data File Empty **"))
((<= (setq dcTag (load_dialog dcfilename)) 0)
(princ "\n** Dialog Definition Not Found **"))
((not (new_dialog "project_names" dcTag))
(princ "\n** Dialog Could not be Loaded **"))
(t
(start_list "lst")
(mapcar (function add_list) StrLst)
(end_list)
(setq ptr (set_tile "lst" "0"))
(action_tile"lst" "(setq ptr $value)")
(setq dcFlag (start_dialog))
(setq dcTag (unload_dialog dcTag) TagString1 (strcase TagString1)
TagString2 (strcase TagString2)
Str (nth (atoi ptr) StrLst))
(if (= 1 dcFlag)
(while (setq ent (ssname ss (setq i (1+ i))))
(while (not (eq "SEQEND" (cdr (assoc 0 (setq eLst (entget (setq ent (entnext ent))))))))
(cond ((eq TagString1 (cdr (assoc 2 eLst)))
(entupd
(cdr (assoc -1 (entmod (subst (cons 1 Str)
(assoc 1 eLst) eLst))))))
((and (eq TagString2 (cdr (assoc 2 eLst)))
(setq pos (vl-string-position 32 Str)))
(entupd
(cdr (assoc -1 (entmod (subst (cons 1 (substr str 1 pos))
(assoc 1 eLst) eLst)))))))))
(princ "\n*Cancel*"))))
(princ))
那么，未经测试的修改现在已经过测试，它的工作处理。谢谢你的帮助，伊尔内布。非常感谢。 不客气！很高兴我能在脑海里这样做。。。意味着我的大脑还有几年的时间
页:
[1]