一条多段线按交点进行编号

白小纯

按照一条多段线与其他多段线的交点进行递增编号

vitalgg

如果无法播放，请点击此处在新窗口打开

1. ;;; 按照一条多段线与其他多段线的交点进行递增编号
   
2. (defun inter-number ()
   
3.   (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   
4. 
   
5.   (@:prompt "请选择一条直线或多段线:")
   
6.   (if (setq lwpl (ssname (ssget ":S" '((0 . "line,lwpolyline"))) 0))
   
7.       (progn
   
8.   (setq box (entity:getbox lwpl 0))
   
9.   (setq lwpls (ssget "c" (car box)(cadr box) '((0 . "*line"))))
   
10.   (setq lwpls (ssdel lwpl lwpls))
    
11.   ;;(setq lwpls (vl-remove lwpl lwpls))
    
12.   ;; 多段线的相交点
    
13.   
    
14.   (setq pts (curve:inters lwpl lwpls acExtendNone))
    
15.   ;; 对交点排序
    
16.   (setq pts
    
17.         (vl-sort pts
    
18.            '(lambda(x y)
    
19.        (< (vlax-curve-getDistAtPoint (e2o lwpl) x)
    
20.         (vlax-curve-getDistAtPoint (e2o lwpl) y)))))
    
21.   ;; 标序号
    
22.   (setq i 0)
    
23.   (foreach pt pts
    
24.      (entity:putdxf
    
25.       (entity:make-text
    
26.        (itoa (setq i (1+ i)))
    
27.        pt
    
28.        1000 0 1 0 "LB")
    
29.       62 1)
    
30.       )
    
31.   )))

;;; 按照一条多段线与其他多段线的交点进行递增编号<br /> (defun inter-number ()<br />   (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br /> <br />   (@:prompt "请选择一条直线或多段线:")<br />   (if (setq lwpl (ssname (ssget ":S" '((0 . "line,lwpolyline"))) 0))<br />       (progn<br />   (setq box (entity:getbox lwpl 0))<br />   (setq lwpls (ssget "c" (car box)(cadr box) '((0 . "*line"))))<br />   (setq lwpls (ssdel lwpl lwpls))<br />   ;;(setq lwpls (vl-remove lwpl lwpls))<br />   ;; 多段线的相交点<br />   <br />   (setq pts (curve:inters lwpl lwpls acExtendNone))<br />   ;; 对交点排序<br />   (setq pts<br />         (vl-sort pts<br />            '(lambda(x y)<br />        (< (vlax-curve-getDistAtPoint (e2o lwpl) x)<br />         (vlax-curve-getDistAtPoint (e2o lwpl) y)))))<br />   ;; 标序号<br />   (setq i 0)<br />   (foreach pt pts<br />      (entity:putdxf<br />       (entity:make-text<br />        (itoa (setq i (1+ i)))<br />        pt<br />        1000 0 1 0 "LB")<br />       62 1)<br />       )<br />   )))

lzspain

vitalgg 发表于 2023-12-21 11:44
看视频。
不是CAD命令，是一个函数。
(inter-number)

还是不行，错误如下：

命令: INFO: Write to register. Please permit it.
INFO: init @lisp cloud ... ok.
Win32: 在多字节的目标代码页中，没有此 Unicode 字符可以映射到的字符。
no function definition: INTER-NUMBERno function definition: INTER-NUMBER

lzspain

vitalgg 发表于 2023-12-20 15:19

这个粘贴到记事本，改为LSP后缀不可用吗？

vitalgg

lzspain 发表于 2023-12-21 09:06
这个粘贴到记事本，改为LSP后缀不可用吗？

需要联网加载需要的函数。

lzspain

vitalgg 发表于 2023-12-21 09:20
需要联网加载需要的函数。

好吧，有点儿复杂，谢谢

vitalgg

lzspain 发表于 2023-12-21 09:32
好吧，有点儿复杂，谢谢

上面代码的函数第一行就是联网加载函数的，不用其它人工操作。
就是需要CAD能联网才能运行。

lzspain

vitalgg 发表于 2023-12-21 10:43
上面代码的函数第一行就是联网加载函数的，不用其它人工操作。
就是需要CAD能联网才能运行。

CAD并没禁网，但是怎么输命令都没用

vitalgg

lzspain 发表于 2023-12-21 11:14
CAD并没禁网，但是怎么输命令都没用

看视频。
不是CAD命令，是一个函数。
(inter-number)

如果你要定义CAD命令，可以

1. (defun c:tt ()
   
2.   (inter-number))
   
3. ;; 可以把 tt 改成你想要的命令

(defun c:tt ()<br />   (inter-number))<br /> ;; 可以把 tt 改成你想要的命令

vitalgg

lzspain 发表于 2023-12-21 12:25
还是不行，错误如下：

命令: INFO: Write to register. Please permit it.

你存成 ANSI编码。
或把代码中的汉字去了。