求高手帮忙编一段提取属性块坐标数值然后把属性块移动到对应坐标的LSP

airuyi

在下是个小白，但是遇到工地测量了几百个结构坐标的XYZ数据，要在图上把这些坐标点画出来，一个个画太慢了，求论坛的高手帮忙编写一个LSP程序，可以输入坐标之后运行LSP命令让属性块自动移动到对应坐标位置。
希望能实现如下功能：
附件已经定义好了这个属性块“自动坐标”的格式。

先在图中选择此属性块（一个或者多个）然后运行LSP命令，或者LSP运行命令后再在图中选择此属性块“自动坐标”（一个或者多个），
然后程序执行如下动作：首先选择坐标值提取方式
   a.整个坐标值提取：
     提取属性块“自动坐标”里面的FXYZ的数值（比如7,8,9之类）（如果不是坐标值就自动选择b方式）然后把这些属性块“自动坐标”分别移动到对应坐标值的位置。
   b.单独坐标提取组合：
      分别提取属性块“自动坐标”里面的FX和FY和FZ的数值（如果不是坐标值就自动选择a方式）组成一个坐标数值，然后把属性块“自动坐标”移到对应的坐标值的位置。
完成所有该属性块移动动作之后结束程序。

Sylvanas

(defun c:tt ()
  (setq cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq osmode (getvar "osmode"))
  (setvar "osmode" 0)
  (setq ss (ssget '((2 . "自动坐标"))))
  (while (setq en (ssname ss 0))
    (setq ss (ssdel en ss))
    (setq ss1 (ssadd))
    (setq ss1 (ssadd en ss1))
    (setq dxf (entget en))
    (setq en1  (entnext en)
          dxf1 (entget en1)
    )
    (if        (wcmatch (setq txt (cdr (assoc 1 dxf1))) "*`,*`,*")
                                        ;(setq txt "1,2,3")(wcmatch  txt  "*`,*`,*")
                                        ;(setq txt "aaa")(wcmatch  txt  "*`,*`,*")
      (setq txt1 ""
            txtl '()
            pt         (reverse (progn (while        (/= txt "")
                                   (setq txt0 (substr txt 1 1))
                                   (if (/= txt0 ",")
                                     (setq txt1 (strcat txt1 txt0))
                                     (setq txtl        (cons (atof txt1) txtl)
                                           txt1        ""
                                     )
                                   )
                                   (setq txt (substr txt 2))
                                 )
                                 (setq txtl (cons (atof txt1) txtl))
                          )
                 )
      )
      (setq pt
             (list (atof (cdr (assoc 1 (entget (setq en1 (entnext en1))))))
                   (atof (cdr (assoc 1 (entget (setq en1 (entnext en1))))))
                   (atof (cdr (assoc 1 (entget (setq en1 (entnext en1))))))
             )
      )
    )
    (command "move" ss1 "" (cdr (assoc 10 dxf)) pt)
  )
  (setvar "cmdecho" cmdecho)
  (setvar "osmode" osmode)
  (princ)
)


试一下吧

Gu_xl

1. (defun c:tt (/ E FX FXYZ FY FZ N OBJ SS STR TAG) (vl-load-com)
   
2.   (if (setq ss (ssget "x" '((0 . "insert") (2 . "自动坐标"))))
   
3.     (repeat (setq n (sslength ss))
   
4.       (setq obj        (vlax-ename->vla-object
   
5.                   (setq e (ssname ss (setq n (1- n))))
   
6.                 )
   
7.       )
   
8.       (foreach att (vlax-invoke obj 'GetAttributes)
   
9.         (setq tag (strcase (vla-get-TagString att))
   
10.               str (vla-get-TextString att)
    
11.         )
    
12.         (if (= "FXYZ" tag)
    
13.           (setq FXYZ str)
    
14.           (if (= "FX" tag)
    
15.             (setq FX str)
    
16.             (if        (= "FY" tag)
    
17.               (setq FY str)
    
18.               (if (= "FZ" tag)
    
19.                 (setq FZ str)
    
20.               )
    
21.             )
    
22.           )
    
23.         )
    
24.       )
    
25.       (while (/= FXYZ (setq FXYZ (vl-string-subst " " "," FXYZ))))
    
26.       (setq FXYZ (read (strcat "(" FXYZ ")")))
    
27.       (if (= 3 (length FXYZ))
    
28.         (progn
    
29.           (vla-put-InsertionPoint obj (vlax-3d-point FXYZ))
    
30.         )
    
31.         (progn
    
32.           (vla-put-InsertionPoint
    
33.             obj
    
34.             (vlax-3d-point (list (atof FX) (atof FY) (atof FZ)))
    
35.           )
    
36.         )
    
37.       )
    
38.     )
    
39.   )
    
40.   (princ)
    
41. )

(defun c:tt (/ E FX FXYZ FY FZ N OBJ SS STR TAG) (vl-load-com)<br />   (if (setq ss (ssget "x" '((0 . "insert") (2 . "自动坐标"))))<br />     (repeat (setq n (sslength ss))<br />       (setq obj        (vlax-ename->vla-object<br />                   (setq e (ssname ss (setq n (1- n))))<br />                 )<br />       )<br />       (foreach att (vlax-invoke obj 'GetAttributes)<br />         (setq tag (strcase (vla-get-TagString att))<br />               str (vla-get-TextString att)<br />         )<br />         (if (= "FXYZ" tag)<br />           (setq FXYZ str)<br />           (if (= "FX" tag)<br />             (setq FX str)<br />             (if        (= "FY" tag)<br />               (setq FY str)<br />               (if (= "FZ" tag)<br />                 (setq FZ str)<br />               )<br />             )<br />           )<br />         )<br />       )<br />       (while (/= FXYZ (setq FXYZ (vl-string-subst " " "," FXYZ))))<br />       (setq FXYZ (read (strcat "(" FXYZ ")")))<br />       (if (= 3 (length FXYZ))<br />         (progn<br />           (vla-put-InsertionPoint obj (vlax-3d-point FXYZ))<br />         )<br />         (progn<br />           (vla-put-InsertionPoint<br />             obj<br />             (vlax-3d-point (list (atof FX) (atof FY) (atof FZ)))<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

Sylvanas

airuyi 发表于 2016-9-29 14:44
不用转换啊，比如原来的坐标点是（1,1,1），就是改了UCS，然后再运行一次程序，就可以把属性块移动到对应 ...

2. (defun c:tt ()
   
3.   (setq cmdecho (getvar "cmdecho"))
   
4.   (setvar "cmdecho" 0)
   
5.   (setq osmode (getvar "osmode"))
   
6.   (setvar "osmode" 0)
   
7.   (setq ss (ssget '((2 . "自动坐标"))))
   
8.   (while (setq en (ssname ss 0))
   
9.     (setq ss (ssdel en ss))
   
10.     (setq ss1 (ssadd))
    
11.     (setq ss1 (ssadd en ss1))
    
12.     (setq dxf (entget en))
    
13.     (setq en1  (entnext en)
    
14.     dxf1 (entget en1)
    
15.     )
    
16.     (setq FXYZ nil)
    
17.     (setq obj (vlax-ename->vla-object en))
    
18.     (foreach att (vlax-invoke obj 'GetAttributes)
    
19.       (setq tag  (strcase (vla-get-TagString att))
    
20.       str  (vla-get-TextString att)
    
21.       )
    
22.       (cond ((= "FXYZ" tag) (setq FXYZ str))
    
23.       ((= "FX" tag) (setq FX str))
    
24.       ((= "FY" tag) (setq FY str))
    
25.       ((= "FZ" tag) (setq FZ str))
    
26.       )
    
27.     )
    
28.     (while (/= FXYZ (setq FXYZ (vl-string-subst " " "," FXYZ))))
    
29.           ;(setq FXYZ "1,2,3")
    
30.     (setq FXYZ (read (strcat "(" FXYZ ")")))
    
31.     (if  (= 3 (length FXYZ))
    
32.       (setq pt FXYZ)
    
33.       (setq pt (list (atof FX) (atof FY) (atof FZ)))
    
34.     )
    
35.     (command "move" ss1 "" (cdr (assoc 10 dxf)) (trans pt 1 0))
    
36.   )
    
37.   (setvar "cmdecho" cmdecho)
    
38.   (setvar "osmode" osmode)
    
39.   (princ)
    
40. )

(defun c:tt ()<br />   (setq cmdecho (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (setq osmode (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq ss (ssget '((2 . "自动坐标"))))<br />   (while (setq en (ssname ss 0))<br />     (setq ss (ssdel en ss))<br />     (setq ss1 (ssadd))<br />     (setq ss1 (ssadd en ss1))<br />     (setq dxf (entget en))<br />     (setq en1  (entnext en)<br />     dxf1 (entget en1)<br />     )<br />     (setq FXYZ nil)<br />     (setq obj (vlax-ename->vla-object en))<br />     (foreach att (vlax-invoke obj 'GetAttributes)<br />       (setq tag  (strcase (vla-get-TagString att))<br />       str  (vla-get-TextString att)<br />       )<br />       (cond ((= "FXYZ" tag) (setq FXYZ str))<br />       ((= "FX" tag) (setq FX str))<br />       ((= "FY" tag) (setq FY str))<br />       ((= "FZ" tag) (setq FZ str))<br />       )<br />     )<br />     (while (/= FXYZ (setq FXYZ (vl-string-subst " " "," FXYZ))))<br />           ;(setq FXYZ "1,2,3")<br />     (setq FXYZ (read (strcat "(" FXYZ ")")))<br />     (if  (= 3 (length FXYZ))<br />       (setq pt FXYZ)<br />       (setq pt (list (atof FX) (atof FY) (atof FZ)))<br />     )<br />     (command "move" ss1 "" (cdr (assoc 10 dxf)) (trans pt 1 0))<br />   )<br />   (setvar "cmdecho" cmdecho)<br />   (setvar "osmode" osmode)<br />   (princ)<br /> )

好像没问题，你试一下

xyp1964

应该利用已测量的结构坐标XYZ数据结果直接插块

airuyi

xyp1964 发表于 2016-9-28 23:33
应该利用已测量的结构坐标XYZ数据结果直接插块

感谢版主回复，版主说得直接插块也是一种好方法，直接插块应该也要编辑坐标数据的。地盘测量出来的数据也都是单独的X数据和单独的Y数据还有单独的Z数据，最后还是要把这些数据变成一个坐标点。还需要在对应的点显示当前坐标，要把数据放到属性块里面。所以我还是希望可以批量导入坐标数据到属性块之后运行LSP使属性块自己移动到对应的位置。
希望有高手可以帮忙解决这个程序吧，谢谢了。

airuyi

Gu_xl 发表于 2016-9-29 09:17

感谢版主，能不能在程序里面加入一个选择的方式，就是说可以选择一个或者几个要移动的属性块，其它不想移动的先不移动？

Sylvanas

airuyi 发表于 2016-9-29 10:06
感谢版主，能不能在程序里面加入一个选择的方式，就是说可以选择一个或者几个要移动的属性块，其它不想移 ...

你把他那段代码里第二行的"x"删了就行了，带引号

airuyi

Sylvanas 发表于 2016-9-29 13:14
你把他那段代码里第二行的"x"删了就行了，带引号

哈哈哈，已经删除了，可以用。谢谢两位高手帮忙！

airuyi

Sylvanas 发表于 2016-9-29 13:14
你把他那段代码里第二行的"x"删了就行了，带引号

请问一下，版主的程序代码是移动到绝对坐标系的，如果我改变了UCS，再使用这个程序，那些属性块是不会动的。有没有办法可以改成相对坐标系，就是说如果我改变了UCS的原点，再使用程序，那么那些属性块会跟着新的UCS重新进行移动。

Sylvanas

airuyi 发表于 2016-9-29 13:53
请问一下，版主的程序代码是移动到绝对坐标系的，如果我改变了UCS，再使用这个程序，那些属性块是不会动 ...

那你问版主吧

说实话他那段代码我有八成没看懂