求自然幢绘制

youyou3810

谁有这个插件

youyou3810

1. (defun c:77 (/ ss n en pt)
   
2. (setq ss (ssget ))
   
3. (if ss
   
4.        (progn
   
5. (entmake
   
6.     (list
   
7.      '(0 . "LWPOLYLINE")
   
8.   '(100 . "AcDbEntity")
   
9.   '(100 . "AcDbPolyline")
   
10.   '(90 . 4)
    
11.   '(70 . 1)
    
12.   '(43 . 0.0)
    
13.   '(38 . 0.0)
    
14.   '(39 . 0.0)
    
15.        (repeat (setq n (sslength ss))
    
16.          (setq en (ssname ss (setq n (1- n))))
    
17.          (setq pt (cdr (assoc 10 (entget en))))
    
18.     (cons 10 pt)
    
19.          )
    
20.    )
    
21.        )
    
22.        )
    
23.   )
    
24. )

(defun c:77 (/ ss n en pt)<br /> (setq ss (ssget ))<br /> (if ss<br />        (progn<br /> (entmake<br />     (list<br />      '(0 . "LWPOLYLINE")<br />   '(100 . "AcDbEntity")<br />   '(100 . "AcDbPolyline")<br />   '(90 . 4)<br />   '(70 . 1)<br />   '(43 . 0.0)<br />   '(38 . 0.0)<br />   '(39 . 0.0)<br />        (repeat (setq n (sslength ss))<br />          (setq en (ssname ss (setq n (1- n))))<br />          (setq pt (cdr (assoc 10 (entget en))))<br />     (cons 10 pt)<br />          )<br />    )<br />        )<br />        )<br />   )<br /> )

没什么作用 后面不知道怎么做

youyou3810

1. (defun c:77 (/ ss n en pt)
   
2. (setq ss (ssget ))
   
3. (if ss
   
4.        (progn
   
5. 
   
6.        (repeat (setq n (sslength ss))
   
7.          (setq en (ssname ss (setq n (1- n))))
   
8.          (setq pt (cdr (assoc 10 (entget en))))
   
9.          (entmake (list '(0 . "CIRCLE")'(40 . 0.5)'(8 . "dwdw")(cons 10 pt)))
   
10. 
    
11.        )
    
12.        )
    
13.   )
    
14. )

(defun c:77 (/ ss n en pt)<br /> (setq ss (ssget ))<br /> (if ss<br />        (progn<br /> <br />        (repeat (setq n (sslength ss))<br />          (setq en (ssname ss (setq n (1- n))))<br />          (setq pt (cdr (assoc 10 (entget en))))<br />          (entmake (list '(0 . "CIRCLE")'(40 . 0.5)'(8 . "dwdw")(cons 10 pt)))<br /> <br />        )<br />        )<br />   )<br /> )

测试结果只取了两个顶点其他顶点信息没有

youyou3810

1. (defun c:44 (/ ss n en en1_data oldr)(setq ss (ssget ))
   
2. (if ss
   
3.        (progn
   
4. 
   
5.        (repeat (setq n (sslength ss))
   
6.          (setq  en (ssname ss (setq n (1- n))))
   
7.          ;转换为vl对象
   
8. (setq en (vlax-ename->vla-object en))
   
9.          ;获取坐标
   
10.   (setq thelist (vlax-get-property en 'coordinates))
    
11.          ;转换为列表
    
12.   (setq thelist (vlax-safearray->list  (variant-value thelist)))
    
13.          ;将计数器清零
    
14.          (setq n 0)
    
15.   ;开始循环
    
16.   (repeat (/ (length thelist) 2)
    
17.    ;获取x坐标
    
18. (setq xval (rtos (nth n thelist)))
    
19.   ;增加计数器
    
20.   (setq n (1+ n))
    
21.      ;获取y坐标
    
22. (setq yval (rtos (nth n thelist)))
    
23.     (entmake (list '(0 . "CIRCLE")'(40 . 0.5)'(8 . "dwdw")(cons 10 xval yval)))
    
24.     (setq n (1+ n))
    
25.     );repeat
    
26.          );repeat
    
27.          );progn
    
28.        );if
    
29.        );defun

(defun c:44 (/ ss n en en1_data oldr)(setq ss (ssget ))<br /> (if ss<br />        (progn<br /> <br />        (repeat (setq n (sslength ss))<br />          (setq  en (ssname ss (setq n (1- n))))<br />          ;转换为vl对象<br /> (setq en (vlax-ename->vla-object en))<br />          ;获取坐标<br />   (setq thelist (vlax-get-property en 'coordinates))<br />          ;转换为列表<br />   (setq thelist (vlax-safearray->list  (variant-value thelist)))<br />          ;将计数器清零<br />          (setq n 0)<br />   ;开始循环<br />   (repeat (/ (length thelist) 2)<br />    ;获取x坐标<br /> (setq xval (rtos (nth n thelist)))<br />   ;增加计数器<br />   (setq n (1+ n))<br />      ;获取y坐标<br /> (setq yval (rtos (nth n thelist)))<br />     (entmake (list '(0 . "CIRCLE")'(40 . 0.5)'(8 . "dwdw")(cons 10 xval yval)))<br />     (setq n (1+ n))<br />     );repeat<br />          );repeat<br />          );progn<br />        );if<br />        );defun

现在获取到各个顶点坐标
(entmake (list '(0 . "CIRCLE")'(40 . 0.5)'(8 . "dwdw")(cons 10 xval yval)))
(cons 10 xval yval)))这个xy坐标不能正常使用求解

youyou3810

(entmake (list '(0 . "CIRCLE")'(40 . 0.5)'(8 . "dwdw")(cons 10 (strcat xval "," yval))))错误: DXF 组不正确: (10 . "584219.2643,3292468.3060")

youyou3810

求助 等着用

Gu_xl

加载XLRX_API

1. (defun c:tt ()
   
2.   (while (and
   
3.            (setq ss (ssget '((0 . "*polyline")
   
4.                              (-4 . "<or")
   
5.                              (70 . 1)
   
6.                              (70 . 129)
   
7.                              (-4 . "or>")
   
8.                             )
   
9.                     )
   
10.            )
    
11.            (> (sslength ss) 1)
    
12.          )
    
13.     (xlrx-copy ss)
    
14.     (setq e1 (ssname ss 0))
    
15.     (ssdel e1 ss)
    
16.     (setq s (XLRX-Curve-Boolean e1 ss 0 1e-3))
    
17.     (mapcar '(lambda (x) (xlrx-set x "color" 7)) s)
    
18.   )
    
19.   (princ)
    
20. )

(defun c:tt ()<br />   (while (and<br />            (setq ss (ssget '((0 . "*polyline")<br />                              (-4 . "<or")<br />                              (70 . 1)<br />                              (70 . 129)<br />                              (-4 . "or>")<br />                             )<br />                     )<br />            )<br />            (> (sslength ss) 1)<br />          )<br />     (xlrx-copy ss)<br />     (setq e1 (ssname ss 0))<br />     (ssdel e1 ss)<br />     (setq s (XLRX-Curve-Boolean e1 ss 0 1e-3))<br />     (mapcar '(lambda (x) (xlrx-set x "color" 7)) s)<br />   )<br />   (princ)<br /> )

youyou3810

厉害！！XLRX_API函数说明文档.chm打开没有文字

youyou3810

youyou3810 发表于 2019-11-24 22:04
厉害！！XLRX_API函数说明文档.chm打开没有文字

如何生成线段放到指定图层