本帖最后由 airuyi 于 2016-9-30 12:11 编辑
![]()
在下是个小白,但是遇到工地测量了几百个结构坐标的XYZ数据,要在图上把这些坐标点画出来,一个个画太慢了,求论坛的高手帮忙编写一个LSP程序,可以输入坐标之后运行LSP命令让属性块自动移动到对应坐标位置。
希望能实现如下功能:
附件已经定义好了这个属性块“自动坐标”的格式。
先在图中选择此属性块(一个或者多个)然后运行LSP命令,或者LSP运行命令后再在图中选择此属性块“自动坐标”(一个或者多个),
然后程序执行如下动作:首先选择坐标值提取方式
a.整个坐标值提取:
提取属性块“自动坐标”里面的FXYZ的数值(比如7,8,9之类)(如果不是坐标值就自动选择b方式)然后把这些属性块“自动坐标”分别移动到对应坐标值的位置。
b.单独坐标提取组合:
分别提取属性块“自动坐标”里面的FX和FY和FZ的数值(如果不是坐标值就自动选择a方式)组成一个坐标数值,然后把属性块“自动坐标”移到对应的坐标值的位置。
完成所有该属性块移动动作之后结束程序。
网友答: 本帖最后由 Sylvanas 于 2016-9-29 09:20 编辑
(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)
)
试一下吧
网友答:
网友答:
本帖最后由 Sylvanas 于 2016-9-29 15:02 编辑

好像没问题,你试一下网友答: 应该利用已测量的结构坐标XYZ数据结果直接插块网友答: 本帖最后由 airuyi 于 2016-9-29 17:23 编辑
感谢版主回复,版主说得直接插块也是一种好方法,直接插块应该也要编辑坐标数据的。地盘测量出来的数据也都是单独的X数据和单独的Y数据还有单独的Z数据,最后还是要把这些数据变成一个坐标点。还需要在对应的点显示当前坐标,要把数据放到属性块里面。所以我还是希望可以批量导入坐标数据到属性块之后运行LSP使属性块自己移动到对应的位置。
希望有高手可以帮忙解决这个程序吧,谢谢了。
网友答:
感谢版主,能不能在程序里面加入一个选择的方式,就是说可以选择一个或者几个要移动的属性块,其它不想移动的先不移动?网友答: 本帖最后由 Sylvanas 于 2016-9-29 13:15 编辑
你把他那段代码里第二行的"x"删了就行了,带引号网友答:
哈哈哈,已经删除了,可以用。谢谢两位高手帮忙!网友答: 本帖最后由 airuyi 于 2016-9-29 13:55 编辑
请问一下,版主的程序代码是移动到绝对坐标系的,如果我改变了UCS,再使用这个程序,那些属性块是不会动的。有没有办法可以改成相对坐标系,就是说如果我改变了UCS的原点,再使用程序,那么那些属性块会跟着新的UCS重新进行移动。网友答:
那你问版主吧
说实话他那段代码我有八成没看懂
在下是个小白,但是遇到工地测量了几百个结构坐标的XYZ数据,要在图上把这些坐标点画出来,一个个画太慢了,求论坛的高手帮忙编写一个LSP程序,可以输入坐标之后运行LSP命令让属性块自动移动到对应坐标位置。
希望能实现如下功能:
附件已经定义好了这个属性块“自动坐标”的格式。
先在图中选择此属性块(一个或者多个)然后运行LSP命令,或者LSP运行命令后再在图中选择此属性块“自动坐标”(一个或者多个),
然后程序执行如下动作:首先选择坐标值提取方式
a.整个坐标值提取:
提取属性块“自动坐标”里面的FXYZ的数值(比如7,8,9之类)(如果不是坐标值就自动选择b方式)然后把这些属性块“自动坐标”分别移动到对应坐标值的位置。
b.单独坐标提取组合:
分别提取属性块“自动坐标”里面的FX和FY和FZ的数值(如果不是坐标值就自动选择a方式)组成一个坐标数值,然后把属性块“自动坐标”移到对应的坐标值的位置。
完成所有该属性块移动动作之后结束程序。
网友答: 本帖最后由 Sylvanas 于 2016-9-29 09:20 编辑
(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)
)
试一下吧
网友答:

- (defun c:tt (/ E FX FXYZ FY FZ N OBJ SS STR TAG) (vl-load-com)
- (if (setq ss (ssget "x" '((0 . "insert") (2 . "自动坐标"))))
- (repeat (setq n (sslength ss))
- (setq obj (vlax-ename->vla-object
- (setq e (ssname ss (setq n (1- n))))
- )
- )
- (foreach att (vlax-invoke obj 'GetAttributes)
- (setq tag (strcase (vla-get-TagString att))
- str (vla-get-TextString att)
- )
- (if (= "FXYZ" tag)
- (setq FXYZ str)
- (if (= "FX" tag)
- (setq FX str)
- (if (= "FY" tag)
- (setq FY str)
- (if (= "FZ" tag)
- (setq FZ str)
- )
- )
- )
- )
- )
- (while (/= FXYZ (setq FXYZ (vl-string-subst " " "," FXYZ))))
- (setq FXYZ (read (strcat "(" FXYZ ")")))
- (if (= 3 (length FXYZ))
- (progn
- (vla-put-InsertionPoint obj (vlax-3d-point FXYZ))
- )
- (progn
- (vla-put-InsertionPoint
- obj
- (vlax-3d-point (list (atof FX) (atof FY) (atof FZ)))
- )
- )
- )
- )
- )
- (princ)
- )
airuyi 发表于 2016-9-29 14:44
不用转换啊,比如原来的坐标点是(1,1,1),就是改了UCS,然后再运行一次程序,就可以把属性块移动到对应 ...

- (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)
- )
- (setq FXYZ nil)
- (setq obj (vlax-ename->vla-object en))
- (foreach att (vlax-invoke obj 'GetAttributes)
- (setq tag (strcase (vla-get-TagString att))
- str (vla-get-TextString att)
- )
- (cond ((= "FXYZ" tag) (setq FXYZ str))
- ((= "FX" tag) (setq FX str))
- ((= "FY" tag) (setq FY str))
- ((= "FZ" tag) (setq FZ str))
- )
- )
- (while (/= FXYZ (setq FXYZ (vl-string-subst " " "," FXYZ))))
- ;(setq FXYZ "1,2,3")
- (setq FXYZ (read (strcat "(" FXYZ ")")))
- (if (= 3 (length FXYZ))
- (setq pt FXYZ)
- (setq pt (list (atof FX) (atof FY) (atof FZ)))
- )
- (command "move" ss1 "" (cdr (assoc 10 dxf)) (trans pt 1 0))
- )
- (setvar "cmdecho" cmdecho)
- (setvar "osmode" osmode)
- (princ)
- )
好像没问题,你试一下网友答: 应该利用已测量的结构坐标XYZ数据结果直接插块网友答: 本帖最后由 airuyi 于 2016-9-29 17:23 编辑
xyp1964 发表于 2016-9-28 23:33
应该利用已测量的结构坐标XYZ数据结果直接插块
感谢版主回复,版主说得直接插块也是一种好方法,直接插块应该也要编辑坐标数据的。地盘测量出来的数据也都是单独的X数据和单独的Y数据还有单独的Z数据,最后还是要把这些数据变成一个坐标点。还需要在对应的点显示当前坐标,要把数据放到属性块里面。所以我还是希望可以批量导入坐标数据到属性块之后运行LSP使属性块自己移动到对应的位置。
希望有高手可以帮忙解决这个程序吧,谢谢了。
网友答:
Gu_xl 发表于 2016-9-29 09:17
感谢版主,能不能在程序里面加入一个选择的方式,就是说可以选择一个或者几个要移动的属性块,其它不想移动的先不移动?网友答: 本帖最后由 Sylvanas 于 2016-9-29 13:15 编辑
airuyi 发表于 2016-9-29 10:06
感谢版主,能不能在程序里面加入一个选择的方式,就是说可以选择一个或者几个要移动的属性块,其它不想移 ...
你把他那段代码里第二行的"x"删了就行了,带引号网友答:
Sylvanas 发表于 2016-9-29 13:14
你把他那段代码里第二行的"x"删了就行了,带引号
哈哈哈,已经删除了,可以用。谢谢两位高手帮忙!网友答: 本帖最后由 airuyi 于 2016-9-29 13:55 编辑
Sylvanas 发表于 2016-9-29 13:14
你把他那段代码里第二行的"x"删了就行了,带引号
请问一下,版主的程序代码是移动到绝对坐标系的,如果我改变了UCS,再使用这个程序,那些属性块是不会动的。有没有办法可以改成相对坐标系,就是说如果我改变了UCS的原点,再使用程序,那么那些属性块会跟着新的UCS重新进行移动。网友答:
airuyi 发表于 2016-9-29 13:53
请问一下,版主的程序代码是移动到绝对坐标系的,如果我改变了UCS,再使用这个程序,那些属性块是不会动 ...
那你问版主吧
说实话他那段代码我有八成没看懂