ZZXXQQ的留言板 - 明经CAD社区

kexiya123 2023-11-12 13:31

大佬，你好！我以前收集到不知哪位大侠编制的旋转体求重量的程序，然后自己稍微改动了一下，但是这个程序不稳定，程序能够提取到封闭区域形心，但是后面计算时有时候会出现偏差，由于对lisp理解比较粗浅，一时找不到原因，肯请大佬出手。
程序如下：
(defun c:xzt1(/ ent obj pt ptls ss)
  (setvar "cmdecho" 0)
  (command "-style" "HZ1" "lxt9.shx,hzfs.shx" "0" "0.7" "0" "n" "n" "n")
  (princ "\n选择闭合区域:")
  (if (setq ss (ssget))
(progn
   (command ".region" ss "")
   (setq ent (entlast))
   (if (= (cdr (assoc 0 (entget ent))) "REGION")
      (progn
      (vl-load-com)
      (setq obj (vlax-ename->vla-object ent))
      (setq centroid (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj))))
      (vla-move obj (vlax-3d-point centroid) (vlax-3d-point (list 0 0 0)))
      (setq momentofinertia1 (vlax-safearray->list (vlax-variant-value (vla-get-momentofinertia obj))))
      (setq principalmoments1 (vlax-safearray->list (vlax-variant-value (vla-get-principalmoments obj))))
      (setq principaldirections1 (vlax-safearray->list (vlax-variant-value (vla-get-principaldirections obj))))
      (setq productofinertia1  (vla-get-productofinertia obj))
      (setq area (vla-get-area obj))
      (setq perimeter (vla-get-perimeter obj))
      (command ".point" centroid)
      (setq ptls (entlast))
      (command ".explode" ent)
      (sssetfirst nil (ssadd ptls (ssadd)))

      (vla-move obj (vlax-3d-point (list 0 0 0)) (vlax-3d-point centroid))
      (setq txthight (/ (getvar "viewsize") 60.0))
      ;(command ".-style" "HZ1" "lxt9.shx,hzfs.shx" "0" "0.7" "0" "n" "n" "n")
      (setq circlerad (* txthight 1.5))
      (setq arrowlen  (* txthight 5))
      (setq angle1 (angle (list 0 0 0) (list (car principaldirections1)(caddr principaldirections1))))
      (setq angle2 (angle (list 0 0 0) (list (cadr principaldirections1)(cadddr principaldirections1))))
      (setq txtpt (polar centroid angle1 arrowlen))
      (entmake (list (cons 0 "line") (cons 10 centroid)(cons 11 txtpt)(cons 62 1)))
      (entmake (list (cons 0 "text") (cons 1 "1") (cons 40 txthight)(cons 10 txtpt)(cons 11 txtpt)(cons 62 1)))
      (setq txtpt (polar centroid angle2 arrowlen))
      (entmake (list (cons 0 "line") (cons 10 centroid)(cons 11 txtpt)(cons 62 1)))
      (entmake (list (cons 0 "text") (cons 1 "2") (cons 40 txthight)(cons 10 txtpt)(cons 11 txtpt)(cons 62 1)))
               (INITGET 128 "Yes No")
               (SETQ YESNO (GETKWORD "是否要显示截面其他属性值(Y/N) : "))
               (if (= YESNO "Yes")
                  (PROGN

                     (setq txtstring (strcat "面积= " (rtos area 2 1)" mm2")
                           txtpt centroid
                     )
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 62 3)(cons 11 txtpt) (cons 7 "HZ1")))
                     (setq txtstring (strcat "周长= " (rtos  perimeter 2 1)" mm")
                           txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
                     )
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 62 3)(cons 11 txtpt) (cons 7 "HZ1")))
                     (setq txtstring (strcat "Ix= " (rtos (car momentofinertia1) 1 7)" mm4")
                           txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
                     )
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 62 3)(cons 11 txtpt) (cons 7 "HZ1")))
                     (setq txtstring (strcat "Iy= " (rtos (cadr momentofinertia1) 1 7)" mm4")
                           txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
                     )
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 62 3)(cons 11 txtpt) (cons 7 "HZ1")))
                     (setq txtstring (strcat "Ixy= " (rtos  productofinertia1 1 7)" mm4")
                           txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
                     )
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 62 3)(cons 11 txtpt) (cons 7 "HZ1")))
                     (setq txtstring (strcat "I1= " (rtos (car principalmoments1) 1 7)" mm4")
                           txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
                     )
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 62 3)(cons 11 txtpt) (cons 7 "HZ1")))
                     (setq txtstring (strcat "I2= " (rtos (cadr principalmoments1) 1 7)" mm4")
                           txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
                     )
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 62 3)(cons 11 txtpt) (cons 7 "HZ1")))
                     (setq obj (car (entsel "\n选择旋转中心轴 : ")) )
                     (IF (and centroid obj)
                           (setq dist (distance centroid (setq pt2 (vlax-curve-getClosestPointTo obj centroid T))))
                        ) ;end IF
                     (setq zhijin (* 2 dist)
                     tiji (* (* pi zhijin) area)
                     zhongliang (/ (* 7.85 tiji) 1000000)
                     )
                     (setq txtstring (strcat "重量= " (rtos  zhongliang 2 1)" kg"))
                     (setq txtpt (polar centroid (* 1.5 pi) (* 2.8 arrowlen)))
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt) (cons 62 1) (cons 11 txtpt) (cons 7 "HZ1") ) )

                     (setq txtstring (strcat "重心半径r= " (rtos  dist 2 1)" mm"))
                     (setq txtpt (polar centroid (* 1.5 pi) (* 3.15 arrowlen)))
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt) (cons 62 1) (cons 11 txtpt) (cons 7 "HZ1") ) )


                  );end PROGN

                  (progn
                     (setq obj (car (entsel "\n选择旋转中心轴 : ")) )
                     (IF (and centroid obj)
                           (setq dist (distance centroid (setq pt2 (vlax-curve-getClosestPointTo obj centroid T))))
                        ) ;end IF
                     (setq zhijin (* 2 dist)
                     tiji (* (* pi zhijin) area)
                     zhongliang (/ (* 7.85 tiji) 1000000)
                     )
                     (setq txtstring (strcat "重量= " (rtos  zhongliang 2 1)" kg"))
                     (setq txtpt (polar centroid (* 1.5 pi) (* 0.25 arrowlen)))
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt) (cons 62 1) (cons 11 txtpt) (cons 7 "HZ1") ) )

                     (setq txtstring (strcat "重心半径r= " (rtos  dist 2 1)" mm"))
                     (setq txtpt (polar centroid (* 1.5 pi) (* 0.5 arrowlen)))
                     (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt) (cons 62 1) (cons 11 txtpt) (cons 7 "HZ1") ) )
                  );end progn
            );end if
)
      (princ "\n错误:图形不闭合,无法计算.")
   )
)
(princ "\n错误:没有选择对象.")
  )
  (princ)
)

luojie110 2017-12-6 15:04

版主，您好。编译时出错，; 错误: 参数值错误: 非负: -1 如何解决？

皇上快溜 2016-11-3 16:39

谢谢老大

皇上快溜 2016-8-7 16:08

ZZXXQQ: (setq pt3 (polar pt2 (angle pt1 pt2) 10))

谢谢老大，梦寐以求的功能实现了

皇上快溜 2016-8-6 14:41

老大你好，这段小代码想定义那个“pt3"不知道怎么定义，想请你指点一下，打扰了，谢谢你
(defun c:qaqa()
(setq pt1 (getpoint "\n基点:"))
pt2 (getpoint pt1 "\n确定方向的第二点:")
pt3 (list
(Pt3=(PT1+ 10))
就是pt3在沿pt1和pt2确定的方向上，距离pt1正交10mm的位置

皇上快溜 2016-7-9 14:00

ZZXXQQ: (if(/= nam "")
(progn
(command "text" (polar p0 (* pi 1.5) (* dz(+ (* (getvar "di ...

谢谢版主，程序很好用，谢谢

皇上快溜 2016-7-8 12:38

版主你好。我这有个小程序，它输出文本的行间距是固定的，2.5。能不能让它的行间距随字高的变化自动变化，如字高的0.8倍？
   (if(/= nam "")
      (progn
      (command "text" (polar p0 (* pi 1.5) (* dz(+ 2.5 (getvar "dimtxt")))) (getvar "dimtxt") "0" nam)
      (setq dz (1+ dz))
      )
   )
   (if(/= mat "")
      (progn
      (command "text" (polar p0 (* pi 1.5) (* dz(+ 2.5 (getvar "dimtxt")))) (getvar "dimtxt") "0" mat)
      (setq dz (1+ dz))
      )
   )

皇上快溜 2016-7-3 00:23

你好，请你帮我看看这个好吗？
http://bbs.mjtd.com/thread-172629-1-1.html

皇上快溜 2016-7-1 16:19

ZZXXQQ: (command "_.leader" pause pause "" "" "" (strcat "正面铣深" (getstring "深 ...

谢谢版主大人，你小小一改动，让我完善了很多应用

皇上快溜 2016-7-1 16:19

ZZXXQQ: (command "_.leader" pause pause "" "" "" (strcat "正面铣深" (getstring "深 ...

谢谢版主大人，你小小一改动，让我完善了很多应用

皇上快溜 2016-6-30 15:42

ZZXXQQ版主好，感谢你在http://bbs.mjtd.com/thread-172581-1-1.html的指点，让我改了好几个程序，，，

我这还有一个小程序想请你教我一下
(defun c:ZMX()
(command "_.leader" pause pause "" "" "" "正面铣深0.00" "" )(princ))
想让文本 "正面铣深0.00" 中的 “0.00” 可以在命令行中人工输入数值
请问，要添加些什么词句？

wuzheng80425 2015-12-14 08:52

ZZXXQQ: @是相对坐标。后面应该跟坐标数，无坐标时为前一点。

谢谢ZZXXQQ版主，爱死你了

lhsjms009 2015-11-28 15:31

谢谢解答！

ZZXXQQ 2015-11-22 09:08

1、取图中全部图块；
2、循环对每个图块处理。

铁血秦狼 2015-11-21 15:20

http://bbs.mjtd.com/thread-170232-1-1.html大神能不能帮我知道一下，我平时只会一些小的程序编写，这个问题主要是依据编码提取同类型图块进入到一个新层，我只会提取单个(setq dgxj (ssget "X" (list (list -3 (list "SOUTH" (cons 1000 "201102"))))))，但是如何进行批量提取并放置在某个新建层中，还望大神指点迷津

铁血秦狼 2015-11-21 12:18

大神你可不可以帮我指导一下这个问题http://bbs.mjtd.com/thread-170232-1-1.html

ZZXXQQ 2015-9-19 08:44

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=87846

BenjaminXM 2015-9-18 20:59

你好，看到有关坐标系变化的函数trans时，看相关网页内容http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100363，这里你点评了“论坛highflybird大师有专门的贴子”，但我没有找到，搜索词为“highflybird 坐标转换”。请问能否帮忙提供一下网页地址？谢谢~

wuzheng80425 2015-8-6 10:51

版主，今天看到别人的一句代码： (command "copy" (ssget) "" ce "@")
想问一下@在LISP里一般起什么作用呢？在网上找了半天，也没有看到有解释的呢？

dingtiedt 2015-7-1 23:30

版主，增强标注-不同图框自动更改全局比例
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100053&fromuid=7309019
ds.lsp运行时，出现“ ; error: no function definition: vlax-enane->vla-object“，加了(vl-load-com) 后又出现“; error: no function definition: *en2obj*"，然后再ap一次，又能正常运行。以后重启cad，都要加载两次，才能正常运行。请问怎么解决？

ZZXXQQ的个人空间 http://www.mjtd.com/?97616 [收藏] [复制] [分享] [RSS]

留言板

ZZXXQQ