Lisp查找重心乐筑天下 - Powered by Discuz! Archiver

ASMI 发表于 2022-7-5 17:15:40

找到了一些时间。

(defun c:gecen(/ actDoc cSet cLst oldSnp cCen cAre cmLst gCen enPt)

(vl-load-com)

(princ "\n<<<Select Regions or 3D-solids >>> ")
(if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
(progn
(setq cLst(mapcar 'vlax-ename->vla-object
                  (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex cSet))))
oldSnp(getvar "OSMODE")
); end setq
(mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
(vla-StartUndoMark
(setq actDoc(vla-get-ActiveDocument
      (vlax-get-acad-object))))
(foreach ent cLst
(if(vlax-property-available-p ent 'Centroid)
(progn
(setq cCen(vlax-get ent 'Centroid)
   cAre(vlax-get ent 'Area)
   cmLst(cons(list cCen cAre)cmLst)
   ); end setq
      ); end progn
); end if
); end foreach
(if
(and
cmLst
(/= 1(length cmLst))
); enad and
(progn
(setq gCen
   (list
(/
   (apply '+
      (mapcar '*
(mapcar 'caar cmLst)(mapcar 'cadr cmLst)))
   (apply '+ (mapcar 'cadr cmLst))
   ); end /
(/
   (apply '+
      (mapcar '*
(mapcar 'cadar cmLst)(mapcar 'cadr cmLst)))
   (apply '+ (mapcar 'cadr cmLst))
   ); end /
); end list
   enPt(polar gCen(/ pi 3)
   (*(getvar "DIMTXT")(getvar "DIMSCALE")5))
   ); end setq
(command "_.qleader" gCen enPt "" "" "temp_text" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
   "\\P"
   "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
   ); end strcat
); end vla-put-TextString
(foreach pt(mapcar 'car cmLst)
(command "_.line" ptgCen "")
(setq enPt(polar pt(/ pi 3)
   (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
(command "_.qleader" pt enPt "" "" "temp_text" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car pt)2 2)
   "\\P"
   "y="(rtos(cadr pt)2 2)
   ); end strcat
); end vla-put-TextString
); end foreach
); end progn
); end if
(mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
(vla-EndUndoMark actDoc)
); end progn
); end if
(princ)
); end of c:gecen

它好吗？当前UCS中的坐标。

filan1a 发表于 2022-7-5 17:17:41

谢谢ASMI
我测试了一下，一直都很好

asos2000 发表于 2022-7-5 17:22:09

这是很棒的Lisp程序
但是这个Lisp程序能得到这个形状的重心吗？

CADkitt 发表于 2022-7-5 17:24:23

我喜欢这个脚本，但它不适用于实体
我得到了这个错误：
; error: ActiveX Server returned the error: unknown name: "AREA"
我对visuallisp知之甚少，所以有谁能解决这个问题？

fixo 发表于 2022-7-5 17:28:34

可以从实体而不是面积中检索体积
这是速成版，虽然不那么优雅
未经测试，自己动手

(defun c:gec(/ actDoc cSet cLst oldSnp cCen cAre cmcList cmvList gCen enPt)

(vl-load-com)

(princ "\n<<<Select Regions or 3D-solids >>> ")
(if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
(progn
(setq cLst(mapcar 'vlax-ename->vla-object
                  (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex cSet))))
oldSnp(getvar "OSMODE")
); end setq
(mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
(vla-StartUndoMark
(setq actDoc(vla-get-ActiveDocument
   (vlax-get-acad-object))))

(foreach obj cLst
(if (vlax-property-available-p obj 'Centroid)
(cond ((eq "AcDbRegion" (vla-get-objectname obj))
(progn
(setq cCen(vlax-get obj 'Centroid)
cAre(vlax-get obj 'Area)
cmcList(cons(list cCen cAre)cmcList)
); end setq
      ); end progn
)
((eq "AcDb3dSolid" (vla-get-objectname obj))
(progn
(setq cCen(vlax-get obj 'Centroid)
cVol(vlax-get obj 'Volume)
cmvList(cons(list cCen cVol)cmvList)
); end setq
      ); end progn
))
); end if
); end foreach

(if
(and
cmcList
(/= 1(length cmcList))
); enad and
(progn
(setq gCen
   (list

(/
(apply '+
   (mapcar '*
(mapcar 'caar cmcList)(mapcar 'cadr cmcList)))
(apply '+ (mapcar 'cadr cmcList))
); end /
(/
(apply '+
   (mapcar '*
(mapcar 'cadar cmcList)(mapcar 'cadr cmcList)))
(apply '+ (mapcar 'cadr cmcList))
); end /
); end list
   enPt (polar gCen(/ pi 3)
(* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
   ); end setq
(command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
"\\P"
"y="(rtos(cadr gCen)2(getvar "DIMDEC"))
); end strcat
); end vla-put-TextString
(foreach pt(mapcar 'car cmcList)
(command "_.line" "_non" pt"_non" gCen "")
(setq enPt(polar pt(/ pi 3)
(*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
(command "_.qleader" pt enPt "" "" "#" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car pt)2 2)
"\\P"
"y="(rtos(cadr pt)2 2)
); end strcat
); end vla-put-TextString
); end foreach
); end progn
); end if
(if
(and
cmvList
(/= 1(length cmvList))
); enad and
(progn
(setq gCen
   (list

(/
(apply '+
   (mapcar '*
(mapcar 'caar cmvList)(mapcar 'cadr cmvList)))
(apply '+ (mapcar 'cadr cmvList))
); end /
(/
(apply '+
   (mapcar '*
(mapcar 'cadar cmvList)(mapcar 'cadr cmvList)))
(apply '+ (mapcar 'cadr cmvList))
); end /
); end list
   enPt (polar gCen(/ pi 3)
(* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
   ); end setq
(command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
"\\P"
"y="(rtos(cadr gCen)2(getvar "DIMDEC"))
); end strcat
); end vla-put-TextString
(foreach pt(mapcar 'car cmvList)
(command "_.line" "_non" pt"_non" gCen "")
(setq enPt(polar pt(/ pi 3)
(*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
(command "_.qleader" pt enPt "" "" "#" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car pt)2 2)
"\\P"
"y="(rtos(cadr pt)2 2)
); end strcat
); end vla-put-TextString
); end foreach
); end progn
)

(mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
(vla-EndUndoMark actDoc)
); end progn
); end if
(princ)
); end of c:gec

~'J'~

mtahir2003pk 发表于 2022-7-5 17:30:33

我用这个lsp代码很好。。。
这个代码太多了帮我
我们可以用这个lsp做更多的工作吗
就像我想把我的使用转移到区域中心一样
&然后将区域质量特性作为文本或多行文字插入到图形中
谢谢和问候

CADkitt 发表于 2022-7-5 17:32:42

它只在x轴和y轴上工作。我自己尝试添加Z，但只成功添加了一个与y值相同的Z值。
(defun c:gec(/ actDoc cSet cLst oldSnp cCen cAre cmcList cmvList gCen enPt)

(vl-load-com)

(princ "\n<<<Select Regions or 3D-solids >>> ")
(if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
(progn
(setq cLst(mapcar 'vlax-ename->vla-object
                  (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex cSet))))
oldSnp(getvar "OSMODE")
); end setq
(mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
(vla-StartUndoMark
(setq actDoc(vla-get-ActiveDocument
   (vlax-get-acad-object))))

(foreach obj cLst
(if (vlax-property-available-p obj 'Centroid)
(cond ((eq "AcDbRegion" (vla-get-objectname obj))
(progn
(setq cCen(vlax-get obj 'Centroid)
cAre(vlax-get obj 'Area)
cmcList(cons(list cCen cAre)cmcList)
); end setq
      ); end progn
)
((eq "AcDb3dSolid" (vla-get-objectname obj))
(progn
(setq cCen(vlax-get obj 'Centroid)
cVol(vlax-get obj 'Volume)
cmvList(cons(list cCen cVol)cmvList)
); end setq
      ); end progn
))
); end if
); end foreach

(if
(and
cmcList
(/= 1(length cmcList))
); enad and
(progn
(setq gCen
   (list

(/
(apply '+
   (mapcar '*
(mapcar 'caar cmcList)(mapcar 'cadr cmcList)))
(apply '+ (mapcar 'cadr cmcList))
); end /
(/
(apply '+
   (mapcar '*
(mapcar 'cadar cmcList)(mapcar 'cadr cmcList)))
(apply '+ (mapcar 'cadr cmcList))
); end /
); end list
   enPt (polar gCen(/ pi 3)
(* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
   ); end setq
(command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
"\\P"
"y="(rtos(cadr gCen)2(getvar "DIMDEC"))
      "\\P"
"z="(rtos(cadr gCen)2(getvar "DIMDEC"))
); end strcat
); end vla-put-TextString
(foreach pt(mapcar 'car cmcList)
(command "_.line" "_non" pt"_non" gCen "")
(setq enPt(polar pt(/ pi 3)
(*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
(command "_.qleader" pt enPt "" "" "#" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car pt)2 2)
"\\P"
"y="(rtos(cadr pt)2 2)
"\\P"
"z="(rtos(cadr pt)2 2)
); end strcat
); end vla-put-TextString
); end foreach
); end progn
); end if
(if
(and
cmvList
(/= 1(length cmvList))
); enad and
(progn
(setq gCen
   (list

(/
(apply '+
   (mapcar '*
(mapcar 'caar cmvList)(mapcar 'cadr cmvList)))
(apply '+ (mapcar 'cadr cmvList))
); end /
(/
(apply '+
   (mapcar '*
(mapcar 'cadar cmvList)(mapcar 'cadr cmvList)))
(apply '+ (mapcar 'cadr cmvList))
); end /
); end list
   enPt (polar gCen(/ pi 3)
(* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
   ); end setq
(command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
"\\P"
"y="(rtos(cadr gCen)2(getvar "DIMDEC"))
"\\P"
"z="(rtos(cadr gCen)2(getvar "DIMDEC"))
); end strcat
); end vla-put-TextString
(foreach pt(mapcar 'car cmvList)
(command "_.line" "_non" pt"_non" gCen "")
(setq enPt(polar pt(/ pi 3)
(*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
(command "_.qleader" pt enPt "" "" "#" "")
(vla-put-TextString
(vlax-ename->vla-object(entlast))
(strcat "x="(rtos(car pt)2 2)
"\\P"
"y="(rtos(cadr pt)2 2)
      "\\P"
"z="(rtos(cadr pt)2 2)
); end strcat
); end vla-put-TextString
); end foreach
); end progn
)

(mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
(vla-EndUndoMark actDoc)
); end progn
); end if
(princ)
); end of c:gec

mtahir2003pk 发表于 2022-7-5 17:38:46

我又找到了一个很好的短代码lsp。。。
此lsp标记区域中心。。。带圆圈。。。
知道我想将ucs移动到区域中心。。。然后将质量特性直接作为文本输入cad
有人知道
massproperty。图纸
RCG。lsp

nathanjh13 发表于 2022-7-5 17:40:59

这些Lisp程序很好。有谁知道有没有一个可以在一系列物体的重心处生成一个圆（就好像它们是由UNION命令组合在一起的，比如说）。

如果我有三个对象，而不是生成三个圆，是否可以在c.o.g处为所有三个零件创建一个圆（就像组合的一样）？

这将有助于我不合并他们，这就是所有。值得一问。

非常感谢您的回复和上述已经完成的工作。
内森

petkovski 发表于 2022-7-5 17:42:24

你好
我无法上传文件。
给我你的邮件地址，我会给你发送质心例程。
当做
佩特科夫斯基

页: 1 [2]

乐筑天下's Archiver