带有多个

Lee Mac · 发表于 2022-7-6 15:03:45

正如我所说，它确实做出了很多假设，它假设信息的形式如下：

x、 y，zr

Lee Mac · 发表于 2022-7-6 15:08:24


(defun c:CirMake  (/ file nl) ; Define Function/Localise Variables
 (vl-load-com) ; Load VL functions
 (if ; If the following is true
   (setq file (getfiled "Select Text File to Read" "" "csv" ) ; Select a file
   (progn ; Wrap the following statements
     (setq file (open file "r")) ; Opent the file for reading
     (while ; While the following
       (setq nl (read-line file)) ; Read a line from the file
       (command "_.circle" ; Invoke the circle command
                "_non" ; Ignore OSNAPS
                (substr nl 1 (vl-string-position 9 nl)) ; Detect the Space in the line and get the text before the space
                (substr nl (+ (vl-string-position 9 nl) 2)))) ; Get the text after the space
     (close file)) ; Close the file
   (princ "\n<!> No File Selected <!>")) ; Else no File was selected
 (princ)) ; Exit Cleanly

JohnM · 发表于 2022-7-6 15:10:40

试试这个。
使用记事本创建名为ctxt的文本文件。txt并将其保存到C：驱动器
文件格式如下：
10,10
1.
15,15
2.
20.75,16.5
0.75
首先是坐标，然后是半径
加载lisp文件并在命令行上键入ccs

copy


[font=Times New Roman](defun c:ccs (/ ff cl n ctx opf rln cnt lynum retv)[/font]
[font=Times New Roman] (setq ff (findfile "c:/ctxt.txt"));_look for text file[/font]
[font=Times New Roman] (if ff[/font]
[font=Times New Roman] (progn[/font]
[font=Times New Roman] (command "undo" "be");_set undo marker[/font]
[font=Times New Roman] (setq cl (getvar "clayer"));_get current layer[/font]
[font=Times New Roman] (setq n 1);_while loop killer[/font]
[font=Times New Roman] (setq ctx '());_empty list[/font]
[font=Times New Roman] (setq opf (open ff "r"));_if file found open it[/font]
[font=Times New Roman] (while (= n 1);_loop to read lines of file[/font]
[font=Times New Roman]   (setq rln (read-line opf))[/font]
[font=Times New Roman] (if rln (setq ctx(cons rln ctx))(setq n nil));_if line not nil write to list else kill loop[/font]
[font=Times New Roman]   );_while[/font]
[font=Times New Roman] (close opf);_close file[/font]
[font=Times New Roman] (if ctx  ;_if file has info continue [/font]
[font=Times New Roman]  (progn[/font]
[font=Times New Roman] (setq ctx (reverse ctx));_flip list from file[/font]
[font=Times New Roman] (setq cnt 0);_loop counter[/font]
[font=Times New Roman] (setq lynum 1);_layer number added to end of layer name[/font]
[font=Times New Roman] (while (< cnt (length ctx));_loop through list[/font]
[font=Times New Roman] (setq x (nth cnt ctx));_coordinates[/font]
[font=Times New Roman] (setq r (nth (1+ cnt) ctx));_redius[/font]
[font=Times New Roman] (setq retv (crly lynum));_call to layer maker[/font]
[font=Times New Roman] (setvar "clayer" (nth 0 retv));_set layer to new layer[/font]
[font=Times New Roman] (setq lynum (nth 1 retv));_layer # counter[/font]
[font=Times New Roman] (command "_circle" x r);_make circle[/font]
[font=Times New Roman] (setq cnt (+ cnt 2));_up loop counter by 2[/font]
[font=Times New Roman] (setq lynum (1+ lynum));_up layer number by 1[/font]
[font=Times New Roman] );_while[/font]
[font=Times New Roman]    );_progn  [/font]
[font=Times New Roman] );_if[/font]
[font=Times New Roman] (setvar "clayer" cl);_reset back to old layer[/font]
[font=Times New Roman] (command "undo" "END");_end undo group[/font]
[font=Times New Roman]   );_progn if txt[/font]
[font=Times New Roman]   );_if txt[/font]
[font=Times New Roman]   (princ)[/font]
[font=Times New Roman]  );_defun[/font]
[font=Times New Roman] [/font]
[font=Times New Roman](defun crly (aug1 / lp1 tbs retval)[/font]
[font=Times New Roman] (command "-purge" "LA" "cir-*" "n");_purge any unused circle layers  [/font]
[font=Times New Roman] (setq lp1 1);_loop killer[/font]
[font=Times New Roman] (while (= lp1 1)[/font]
[font=Times New Roman] (setq tbs (tblsearch "layer" (strcat "cir-" (itoa aug1))));_search for layer[/font]
[font=Times New Roman] (if tbs  ;_if found  [/font]
[font=Times New Roman] (setq aug1 (1+ aug1));_up layer # by 1[/font]
[font=Times New Roman] (progn[/font]
[font=Times New Roman] (setq lp1 nil);_kill loop if layer not found[/font]
[font=Times New Roman] (setq retval (strcat "cir-" (itoa aug1)));_new layer name[/font]
[font=Times New Roman] (command "-layer" "n" retval "");_make new layer[/font]
[font=Times New Roman] );_progn[/font]
[font=Times New Roman] );_if[/font]
[font=Times New Roman]   );_while[/font]
[font=Times New Roman] (list retval aug1);_return layer name and layer number[/font]
[font=Times New Roman]);_defun[/font]
[font=Times New Roman][/font]

Lee Mac · 发表于 2022-7-6 15:14:35

如果已将Excel文件的内容直接复制到txt文件中，并且Excel文件中的数据格式为：

x y r

正如您之前提到的，这可能会起作用：

copy


(defun c:CirMake (/ *error* vlst ovar file nl lst)
 (vl-load-com)
 (defun *error* (msg)
   (if ovar (mapcar 'setvar vlst ovar))
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))
 (setq vlst '("CMDECHO" "OSMODE")
       ovar (mapcar 'getvar vlst))
 (mapcar 'setvar vlst '(0 0))
 (if (setq file (getfiled "Select Text File to Read" "" "txt" )
   (progn
     (setq file (open file "r"))
     (while (setq nl (read-line file))
       (setq lst (StrBrk nl 9))
       (command "_.circle"
                (list (distof (car lst))
                      (distof (cadr lst)) 0.0) (caddr lst)))
     (close file))
   (princ "\n<!> No File Selected <!>"))
 (princ))
(defun StrBrk (str chrc / pos lst)
 (while (setq pos (vl-string-position chrc str))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (reverse (cons str lst)))

JohnM · 发表于 2022-7-6 15:18:24

哇，这是错误的方式张贴

copy

 
(defun c:ccs (/ ff cl n ctx opf rln cnt lynum retv)
(setq ff (findfile "c:/ctxt.txt"));_look for text file
(if ff
(progn
(command "undo" "be");_set undo marker
(setq cl (getvar "clayer"));_get current layer
(setq n 1);_while loop killer
(setq ctx '());_empty list
(setq opf (open ff "r"));_if file found open it
(while (= n 1);_loop to read lines of file
  (setq rln (read-line opf))
(if rln (setq ctx(cons rln ctx))(setq n nil));_if line not nil write to list else kill loop
  );_while
(close opf);_close file
(if ctx  ;_if file has info continue 
 (progn
(setq ctx (reverse ctx));_flip list from file
(setq cnt 0);_loop counter
(setq lynum 1);_layer number added to end of layer name
(while (< cnt (length ctx));_loop through list
(setq x (nth cnt ctx));_coordinates
(setq r (nth (1+ cnt) ctx));_redius
(setq retv (crly lynum));_call to layer maker
(setvar "clayer" (nth 0 retv));_set layer to new layer
(setq lynum (nth 1 retv));_layer # counter
(command "_circle" x r);_make circle
(setq cnt (+ cnt 2));_up loop counter by 2
(setq lynum (1+ lynum));_up layer number by 1
);_while
   );_progn  
);_if
(setvar "clayer" cl);_reset back to old layer
(command "undo" "END");_end undo group
  );_progn if txt
  );_if txt
  (princ)
 );_defun
(defun crly (aug1 / lp1 tbs retval)
(command "-purge" "LA" "cir-*" "n");_purge any unused circle layers  
(setq lp1 1);_loop killer
(while (= lp1 1)
(setq tbs (tblsearch "layer" (strcat "cir-" (itoa aug1))));_search for layer
(if tbs  ;_if found  
(setq aug1 (1+ aug1));_up layer # by 1
(progn
(setq lp1 nil);_kill loop if layer not found
(setq retval (strcat "cir-" (itoa aug1)));_new layer name
(command "-layer" "n" retval "");_make new layer
);_progn
);_if
  );_while
(list retval aug1);_return layer name and layer number
);_defun

SSA · 发表于 2022-7-6 15:21:47

正在加载C:\Auto Files试用版\CirMake。lsp
：STRBRK

这就是我得到的。
我创建了名为ctxt的文本文件。txt文件
上传cirmake

SSA · 发表于 2022-7-6 15:24:07

为此我得到了

_加载
：ccs
：撤消
撤消：标记/返回到标记/开始设置/结束设置/控制/自动/：be
：-purgeerror:拒绝的函数

我错过了什么？
谢谢

JohnM · 发表于 2022-7-6 15:27:28

我不熟悉IntelliCAD
因此，这可能只是undo和purge命令的一些语法错误。
看起来它希望（命令“undo”“END”）读取（命令“undo”“E”）
或（命令“undo”“End set”）
所以只要做出改变，看看会发生什么。

清除错误是另一回事。在您的IntelliCAD上
命令行类型–清除并查看它是否为可用命令。如果没有，请找出IntelliCAD中是否有清除命令

. 现在，您可以用分号注释清除命令行
像这样放在括号之前；（命令“-清除………。

如果IntelliCAD
有一个不同的清除命令，我们必须将其替换为我的命令，并使其工作。
我只是觉得如果你删除了圆圈，最好清除未使用的图层。

Lee Mac · 发表于 2022-7-6 15:29:52

你复制了框架中的所有代码吗？

SSA · 发表于 2022-7-6 15:34:18

是的，我做了。
框架中的所有代码。
我会再试一次，也许文本文件有一些格式问题？

谢谢大家今天的帮助。我真的很感激。

[编程交流] 带有多个

发表回复

精选推荐