明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2135|回复: 30

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

[复制链接]
发表于 2016-9-28 23:06 | 显示全部楼层 |阅读模式
本帖最后由 airuyi 于 2016-9-30 12:11 编辑


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

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2016-9-29 09:13 | 显示全部楼层
本帖最后由 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)
)


试一下吧

评分

参与人数 1明经币 +1 金钱 +10 收起 理由
airuyi + 1 + 10 厉害啊,这么快就解决了,非常感谢。

查看全部评分

发表于 2016-9-29 09:17 | 显示全部楼层
  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. )

评分

参与人数 1金钱 +5 收起 理由
airuyi + 5 感谢版主!

查看全部评分

发表于 2016-9-29 15:01 | 显示全部楼层
本帖最后由 Sylvanas 于 2016-9-29 15:02 编辑
airuyi 发表于 2016-9-29 14:44
不用转换啊,比如原来的坐标点是(1,1,1),就是改了UCS,然后再运行一次程序,就可以把属性块移动到对应 ...
  1. (defun c:tt ()
  2.   (setq cmdecho (getvar "cmdecho"))
  3.   (setvar "cmdecho" 0)
  4.   (setq osmode (getvar "osmode"))
  5.   (setvar "osmode" 0)
  6.   (setq ss (ssget '((2 . "自动坐标"))))
  7.   (while (setq en (ssname ss 0))
  8.     (setq ss (ssdel en ss))
  9.     (setq ss1 (ssadd))
  10.     (setq ss1 (ssadd en ss1))
  11.     (setq dxf (entget en))
  12.     (setq en1  (entnext en)
  13.     dxf1 (entget en1)
  14.     )
  15.     (setq FXYZ nil)
  16.     (setq obj (vlax-ename->vla-object en))
  17.     (foreach att (vlax-invoke obj 'GetAttributes)
  18.       (setq tag  (strcase (vla-get-TagString att))
  19.       str  (vla-get-TextString att)
  20.       )
  21.       (cond ((= "FXYZ" tag) (setq FXYZ str))
  22.       ((= "FX" tag) (setq FX str))
  23.       ((= "FY" tag) (setq FY str))
  24.       ((= "FZ" tag) (setq FZ str))
  25.       )
  26.     )
  27.     (while (/= FXYZ (setq FXYZ (vl-string-subst " " "," FXYZ))))
  28.           ;(setq FXYZ "1,2,3")
  29.     (setq FXYZ (read (strcat "(" FXYZ ")")))
  30.     (if  (= 3 (length FXYZ))
  31.       (setq pt FXYZ)
  32.       (setq pt (list (atof FX) (atof FY) (atof FZ)))
  33.     )
  34.     (command "move" ss1 "" (cdr (assoc 10 dxf)) (trans pt 1 0))
  35.   )
  36.   (setvar "cmdecho" cmdecho)
  37.   (setvar "osmode" osmode)
  38.   (princ)
  39. )

好像没问题,你试一下
发表于 2016-9-28 23:33 | 显示全部楼层
应该利用已测量的结构坐标XYZ数据结果直接插块
 楼主| 发表于 2016-9-29 09:01 | 显示全部楼层
本帖最后由 airuyi 于 2016-9-29 17:23 编辑
xyp1964 发表于 2016-9-28 23:33
应该利用已测量的结构坐标XYZ数据结果直接插块

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

点评

可以提供一个xyz坐标数据文件供测试  发表于 2016-9-29 09:20
 楼主| 发表于 2016-9-29 10:06 | 显示全部楼层

感谢版主,能不能在程序里面加入一个选择的方式,就是说可以选择一个或者几个要移动的属性块,其它不想移动的先不移动?
发表于 2016-9-29 13:14 | 显示全部楼层
本帖最后由 Sylvanas 于 2016-9-29 13:15 编辑
airuyi 发表于 2016-9-29 10:06
感谢版主,能不能在程序里面加入一个选择的方式,就是说可以选择一个或者几个要移动的属性块,其它不想移 ...

你把他那段代码里第二行的"x"删了就行了,带引号
 楼主| 发表于 2016-9-29 13:40 | 显示全部楼层
Sylvanas 发表于 2016-9-29 13:14
你把他那段代码里第二行的"x"删了就行了,带引号

哈哈哈,已经删除了,可以用。谢谢两位高手帮忙!
 楼主| 发表于 2016-9-29 13:53 | 显示全部楼层
本帖最后由 airuyi 于 2016-9-29 13:55 编辑
Sylvanas 发表于 2016-9-29 13:14
你把他那段代码里第二行的"x"删了就行了,带引号

请问一下,版主的程序代码是移动到绝对坐标系的,如果我改变了UCS,再使用这个程序,那些属性块是不会动的。有没有办法可以改成相对坐标系,就是说如果我改变了UCS的原点,再使用程序,那么那些属性块会跟着新的UCS重新进行移动。
发表于 2016-9-29 14:00 | 显示全部楼层
airuyi 发表于 2016-9-29 13:53
请问一下,版主的程序代码是移动到绝对坐标系的,如果我改变了UCS,再使用这个程序,那些属性块是不会动 ...

那你问版主吧

说实话他那段代码我有八成没看懂
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 13:37 , Processed in 0.366341 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表