乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
楼主: asos2000

[编程交流] Lisp查找重心

[复制链接]
ASMI

2

主题

439

帖子

536

银币

限制会员

铜币
-14
发表于 2022-7-5 17:15:40 | 显示全部楼层
找到了一些时间。
 
  1. (defun c:gecen(/ actDoc cSet cLst oldSnp cCen cAre cmLst gCen enPt)
  2.  
  3.  (vl-load-com)
  4.  
  5.  (princ "\n<<<Select Regions or 3D-solids >>> ")
  6.  (if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
  7.    (progn
  8.      (setq cLst(mapcar 'vlax-ename->vla-object
  9.                       (vl-remove-if 'listp
  10.                         (mapcar 'cadr(ssnamex cSet))))
  11.     oldSnp(getvar "OSMODE")
  12.     ); end setq
  13.      (mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
  14.      (vla-StartUndoMark
  15. (setq actDoc(vla-get-ActiveDocument
  16.               (vlax-get-acad-object))))
  17.      (foreach ent cLst
  18. (if(vlax-property-available-p ent 'Centroid)
  19.   (progn
  20.     (setq cCen(vlax-get ent 'Centroid)
  21.           cAre(vlax-get ent 'Area)
  22.           cmLst(cons(list cCen cAre)cmLst)
  23.           ); end setq
  24.            ); end progn
  25.   ); end if
  26. ); end foreach
  27.    (if
  28.      (and
  29. cmLst
  30. (/= 1(length cmLst))
  31. ); enad and
  32.      (progn
  33. (setq gCen
  34.        (list
  35.          (/
  36.            (apply '+
  37.               (mapcar '*
  38.                  (mapcar 'caar cmLst)(mapcar 'cadr cmLst)))
  39.            (apply '+ (mapcar 'cadr cmLst))
  40.            ); end /
  41.          (/
  42.            (apply '+
  43.               (mapcar '*
  44.                  (mapcar 'cadar cmLst)(mapcar 'cadr cmLst)))
  45.            (apply '+ (mapcar 'cadr cmLst))
  46.            ); end /
  47.          ); end list
  48.       enPt(polar gCen(/ pi 3)
  49.                    (*(getvar "DIMTXT")(getvar "DIMSCALE")5))
  50.       ); end setq
  51. (command "_.qleader" gCen enPt "" "" "temp_text" "")
  52. (vla-put-TextString
  53.     (vlax-ename->vla-object(entlast))
  54.     (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
  55.             "\\P"
  56.             "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
  57.             ); end strcat
  58.     ); end vla-put-TextString
  59. (foreach pt(mapcar 'car cmLst)
  60.   (command "_.line" pt  gCen "")
  61.   (setq enPt(polar pt(/ pi 3)
  62.                    (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  63.   (command "_.qleader" pt enPt "" "" "temp_text" "")
  64.   (vla-put-TextString
  65.     (vlax-ename->vla-object(entlast))
  66.     (strcat "x="(rtos(car pt)2 2)
  67.             "\\P"
  68.             "y="(rtos(cadr pt)2 2)
  69.             ); end strcat
  70.     ); end vla-put-TextString
  71.   ); end foreach
  72. ); end progn
  73.      ); end if
  74.      (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
  75.      (vla-EndUndoMark actDoc)
  76.      ); end progn
  77.    ); end if
  78.  (princ)
  79.  ); end of c:gecen

 
它好吗？当前UCS中的坐标。
174203nr7mua87rra5uw7w.jpg
回复

使用道具 举报

filan1a

2

主题

19

帖子

19

银币

初来乍到

Rank: 1

铜币
9
发表于 2022-7-5 17:17:41 | 显示全部楼层
谢谢ASMI
我测试了一下，一直都很好
回复

使用道具 举报

asos2000

51

主题

481

帖子

457

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
262
发表于 2022-7-5 17:22:09 | 显示全部楼层
这是很棒的Lisp程序
但是这个Lisp程序能得到这个形状的重心吗？
174204n0e000cvh22qha2y.jpg
回复

使用道具 举报

CADkitt

20

主题

81

帖子

61

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
100
发表于 2022-7-5 17:24:23 | 显示全部楼层
我喜欢这个脚本，但它不适用于实体
我得到了这个错误：
  1. ; error: ActiveX Server returned the error: unknown name: "AREA"

我对visuallisp知之甚少，所以有谁能解决这个问题？
回复

使用道具 举报

fixo

1

主题

1069

帖子

1050

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
69
发表于 2022-7-5 17:28:34 | 显示全部楼层
可以从实体而不是面积中检索体积
这是速成版，虽然不那么优雅
未经测试，自己动手
  2. (defun c:gec(/ actDoc cSet cLst oldSnp cCen cAre cmcList cmvList gCen enPt)
  4.  (vl-load-com)
  6.  (princ "\n<<<Select Regions or 3D-solids >>> ")
  7.  (if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
  8.    (progn
  9.      (setq cLst(mapcar 'vlax-ename->vla-object
  10.                       (vl-remove-if 'listp
  11.                         (mapcar 'cadr(ssnamex cSet))))
  12.     oldSnp(getvar "OSMODE")
  13.     ); end setq
  14.      (mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
  15.      (vla-StartUndoMark
  16. (setq actDoc(vla-get-ActiveDocument
  17.        (vlax-get-acad-object))))
  19.      (foreach obj cLst
  20. (if (vlax-property-available-p obj 'Centroid)
  21.   (cond ((eq "AcDbRegion" (vla-get-objectname obj))
  22.   (progn
  23.     (setq cCen(vlax-get obj 'Centroid)
  24.    cAre(vlax-get obj 'Area)
  25.    cmcList(cons(list cCen cAre)cmcList)
  26.    ); end setq
  27.            ); end progn
  28.   )
  29.  ((eq "AcDb3dSolid" (vla-get-objectname obj))
  30.   (progn
  31.     (setq cCen(vlax-get obj 'Centroid)
  32.    cVol(vlax-get obj 'Volume)
  33.    cmvList(cons(list cCen cVol)cmvList)
  34.    ); end setq
  35.            ); end progn
  36.   ))
  37.   ); end if
  38. ); end foreach
  40.    (if
  41.      (and
  42. cmcList
  43. (/= 1(length cmcList))
  44. ); enad and
  45.      (progn
  46. (setq gCen
  47.        (list
  49.   (/
  50.     (apply '+
  51.        (mapcar '*
  52.    (mapcar 'caar cmcList)(mapcar 'cadr cmcList)))
  53.     (apply '+ (mapcar 'cadr cmcList))
  54.     ); end /
  55.   (/
  56.     (apply '+
  57.        (mapcar '*
  58.    (mapcar 'cadar cmcList)(mapcar 'cadr cmcList)))
  59.     (apply '+ (mapcar 'cadr cmcList))
  60.     ); end /
  61.   ); end list
  62.       enPt (polar gCen(/ pi 3)
  63.      (* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
  64.       ); end setq
  65. (command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
  66. (vla-put-TextString
  67.     (vlax-ename->vla-object(entlast))
  68.     (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
  69.      "[url="file://\\P"]\\P[/url]"
  70.      "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
  71.      ); end strcat
  72.     ); end vla-put-TextString
  73. (foreach pt(mapcar 'car cmcList)
  74.   (command "_.line" "_non" pt  "_non" gCen "")
  75.   (setq enPt(polar pt(/ pi 3)
  76.      (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  77.   (command "_.qleader" pt enPt "" "" "#" "")
  78.   (vla-put-TextString
  79.     (vlax-ename->vla-object(entlast))
  80.     (strcat "x="(rtos(car pt)2 2)
  81.      "[url="file://\\P"]\\P[/url]"
  82.      "y="(rtos(cadr pt)2 2)
  83.      ); end strcat
  84.     ); end vla-put-TextString
  85.   ); end foreach
  86. ); end progn
  87.      ); end if
  88. (if
  89.      (and
  90. cmvList
  91. (/= 1(length cmvList))
  92. ); enad and
  93.      (progn
  94. (setq gCen
  95.        (list
  97.   (/
  98.     (apply '+
  99.        (mapcar '*
  100.    (mapcar 'caar cmvList)(mapcar 'cadr cmvList)))
  101.     (apply '+ (mapcar 'cadr cmvList))
  102.     ); end /
  103.   (/
  104.     (apply '+
  105.        (mapcar '*
  106.    (mapcar 'cadar cmvList)(mapcar 'cadr cmvList)))
  107.     (apply '+ (mapcar 'cadr cmvList))
  108.     ); end /
  109.   ); end list
  110.       enPt (polar gCen(/ pi 3)
  111.      (* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
  112.       ); end setq
  113. (command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
  114. (vla-put-TextString
  115.     (vlax-ename->vla-object(entlast))
  116.     (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
  117.      "[url="file://\\P"]\\P[/url]"
  118.      "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
  119.      ); end strcat
  120.     ); end vla-put-TextString
  121. (foreach pt(mapcar 'car cmvList)
  122.   (command "_.line" "_non" pt  "_non" gCen "")
  123.   (setq enPt(polar pt(/ pi 3)
  124.      (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  125.   (command "_.qleader" pt enPt "" "" "#" "")
  126.   (vla-put-TextString
  127.     (vlax-ename->vla-object(entlast))
  128.     (strcat "x="(rtos(car pt)2 2)
  129.      "[url="file://\\P"]\\P[/url]"
  130.      "y="(rtos(cadr pt)2 2)
  131.      ); end strcat
  132.     ); end vla-put-TextString
  133.   ); end foreach
  134. ); end progn
  135.      )
  137.      (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
  138.      (vla-EndUndoMark actDoc)
  139.      ); end progn
  140.    ); end if
  141.  (princ)
  142.  ); end of c:gec

 
~'J'~
回复

使用道具 举报

mtahir2003pk

0

主题

3

帖子

3

银币

初来乍到

Rank: 1

铜币
0
发表于 2022-7-5 17:30:33 | 显示全部楼层
我用这个lsp代码很好。。。
这个代码太多了帮我
我们可以用这个lsp做更多的工作吗
就像我想把我的使用转移到区域中心一样
&然后将区域质量特性作为文本或多行文字插入到图形中
谢谢和问候
回复

使用道具 举报

CADkitt

20

主题

81

帖子

61

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
100
发表于 2022-7-5 17:32:42 | 显示全部楼层
它只在x轴和y轴上工作。我自己尝试添加Z，但只成功添加了一个与y值相同的Z值。
  1. (defun c:gec(/ actDoc cSet cLst oldSnp cCen cAre cmcList cmvList gCen enPt)
  3.  (vl-load-com)
  5.  (princ "\n<<<Select Regions or 3D-solids >>> ")
  6.  (if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
  7.    (progn
  8.      (setq cLst(mapcar 'vlax-ename->vla-object
  9.                       (vl-remove-if 'listp
  10.                         (mapcar 'cadr(ssnamex cSet))))
  11.     oldSnp(getvar "OSMODE")
  12.     ); end setq
  13.      (mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
  14.      (vla-StartUndoMark
  15. (setq actDoc(vla-get-ActiveDocument
  16.        (vlax-get-acad-object))))
  18.      (foreach obj cLst
  19. (if (vlax-property-available-p obj 'Centroid)
  20.   (cond ((eq "AcDbRegion" (vla-get-objectname obj))
  21.   (progn
  22.     (setq cCen(vlax-get obj 'Centroid)
  23.    cAre(vlax-get obj 'Area)
  24.    cmcList(cons(list cCen cAre)cmcList)
  25.    ); end setq
  26.            ); end progn
  27.   )
  28.  ((eq "AcDb3dSolid" (vla-get-objectname obj))
  29.   (progn
  30.     (setq cCen(vlax-get obj 'Centroid)
  31.    cVol(vlax-get obj 'Volume)
  32.    cmvList(cons(list cCen cVol)cmvList)
  33.    ); end setq
  34.            ); end progn
  35.   ))
  36.   ); end if
  37. ); end foreach
  39.    (if
  40.      (and
  41. cmcList
  42. (/= 1(length cmcList))
  43. ); enad and
  44.      (progn
  45. (setq gCen
  46.        (list
  48.   (/
  49.     (apply '+
  50.        (mapcar '*
  51.    (mapcar 'caar cmcList)(mapcar 'cadr cmcList)))
  52.     (apply '+ (mapcar 'cadr cmcList))
  53.     ); end /
  54.   (/
  55.     (apply '+
  56.        (mapcar '*
  57.    (mapcar 'cadar cmcList)(mapcar 'cadr cmcList)))
  58.     (apply '+ (mapcar 'cadr cmcList))
  59.     ); end /
  60.   ); end list
  61.       enPt (polar gCen(/ pi 3)
  62.      (* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
  63.       ); end setq
  64. (command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
  65. (vla-put-TextString
  66.     (vlax-ename->vla-object(entlast))
  67.     (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
  68.      "\\P"
  69.      "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
  70.            "\\P"
  71.      "z="(rtos(cadr gCen)2(getvar "DIMDEC"))
  72.      ); end strcat
  73.     ); end vla-put-TextString
  74. (foreach pt(mapcar 'car cmcList)
  75.   (command "_.line" "_non" pt  "_non" gCen "")
  76.   (setq enPt(polar pt(/ pi 3)
  77.      (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  78.   (command "_.qleader" pt enPt "" "" "#" "")
  79.   (vla-put-TextString
  80.     (vlax-ename->vla-object(entlast))
  81.     (strcat "x="(rtos(car pt)2 2)
  82.      "\\P"
  83.      "y="(rtos(cadr pt)2 2)
  84. "\\P"
  85.      "z="(rtos(cadr pt)2 2)
  86.      ); end strcat
  87.     ); end vla-put-TextString
  88.   ); end foreach
  89. ); end progn
  90.      ); end if
  91. (if
  92.      (and
  93. cmvList
  94. (/= 1(length cmvList))
  95. ); enad and
  96.      (progn
  97. (setq gCen
  98.        (list
  100.   (/
  101.     (apply '+
  102.        (mapcar '*
  103.    (mapcar 'caar cmvList)(mapcar 'cadr cmvList)))
  104.     (apply '+ (mapcar 'cadr cmvList))
  105.     ); end /
  106.   (/
  107.     (apply '+
  108.        (mapcar '*
  109.    (mapcar 'cadar cmvList)(mapcar 'cadr cmvList)))
  110.     (apply '+ (mapcar 'cadr cmvList))
  111.     ); end /
  112.   ); end list
  113.       enPt (polar gCen(/ pi 3)
  114.      (* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
  115.       ); end setq
  116. (command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
  117. (vla-put-TextString
  118.     (vlax-ename->vla-object(entlast))
  119.     (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
  120.      "\\P"
  121.      "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
  122. "\\P"
  123.      "z="(rtos(cadr gCen)2(getvar "DIMDEC"))
  124.      ); end strcat
  125.     ); end vla-put-TextString
  126. (foreach pt(mapcar 'car cmvList)
  127.   (command "_.line" "_non" pt  "_non" gCen "")
  128.   (setq enPt(polar pt(/ pi 3)
  129.      (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  130.   (command "_.qleader" pt enPt "" "" "#" "")
  131.   (vla-put-TextString
  132.     (vlax-ename->vla-object(entlast))
  133.     (strcat "x="(rtos(car pt)2 2)
  134.      "\\P"
  135.      "y="(rtos(cadr pt)2 2)
  136.            "\\P"
  137.      "z="(rtos(cadr pt)2 2)
  138.      ); end strcat
  139.     ); end vla-put-TextString
  140.   ); end foreach
  141. ); end progn
  142.      )
  144.      (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
  145.      (vla-EndUndoMark actDoc)
  146.      ); end progn
  147.    ); end if
  148.  (princ)
  149.  ); end of c:gec
回复

使用道具 举报

mtahir2003pk

0

主题

3

帖子

3

银币

初来乍到

Rank: 1

铜币
0
发表于 2022-7-5 17:38:46 | 显示全部楼层
我又找到了一个很好的短代码lsp。。。
此lsp标记区域中心。。。带圆圈。。。
知道我想将ucs移动到区域中心。。。然后将质量特性直接作为文本输入cad
有人知道
massproperty。图纸
RCG。lsp
回复

使用道具 举报

nathanjh13

1

主题

4

帖子

3

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-5 17:40:59 | 显示全部楼层
这些Lisp程序很好。有谁知道有没有一个可以在一系列物体的重心处生成一个圆（就好像它们是由UNION命令组合在一起的，比如说）。
 
如果我有三个对象，而不是生成三个圆，是否可以在c.o.g处为所有三个零件创建一个圆（就像组合的一样）？
 
这将有助于我不合并他们，这就是所有。值得一问。
 
非常感谢您的回复和上述已经完成的工作。
内森
回复

使用道具 举报

petkovski

3

主题

10

帖子

7

银币

初来乍到

Rank: 1

铜币
15
发表于 2022-7-5 17:42:24 | 显示全部楼层
你好
我无法上传文件。
给我你的邮件地址，我会给你发送质心例程。
当做
佩特科夫斯基
回复

使用道具 举报

12
返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-8-24 15:32 , Processed in 2.001205 second(s), 73 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表