找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 676|回复: 14

[编程申请] 统计

[复制链接]
发表于 2021-10-1 10:07:39 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

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

×
哪位大哥能帮我修改一下下面的代码呢?每次框选完都要输入文字的高度,我想能不能在代码上设置个默认的文字高度呢,如果默认的文字高度不好并且还可以再自定义修改。可以吗?
下面是源代码:

  1. (princ "\n程序:统计面积、长度 命令:tj")
  2. (defun C:tj (/ ss l i totalarea ename obj entarea)
  3.   (if (setq ss (ssget))
  4. (progn
  5. (vl-load-com)
  6. (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
  7.       (setq l (sslength ss) i 0 totalarea 0 totlength 0)
  8. (repeat l
  9. (setq ename (ssname ss i))
  10. (setq obj (vlax-ename->vla-object ename))
  11. (if (vlax-property-available-p obj "area")
  12. (setq totalarea (+ (vlax-get-property obj 'area) totalarea))
  13.         )
  14. (if (= (cdr (assoc 0 (entget ename))) "MLINE")
  15.    (setq totlength (+ totlength (ml-length ename)))
  16.    (setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
  17. )
  18.         (setq i (1+ i))
  19.       )
  20.       (setq text1 (strcat "总面积为: " (rtos (/ totalarea 1000000) 2 2) "平方米")
  21.      text2 (strcat "总长度为: " (rtos (/ totlength 1000) 2 3) "米")
  22.       )
  23.       (if (setq insertpt (getpoint "\n请输入文字插入点: "))
  24. (if (setq height (getdist "\n请输入文字高度:"))
  25.    (setq insertp1 (vlax-3d-point insertpt)
  26.   insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
  27.          textobj1 (vla-addtext modelspace text1 insertp1 height)
  28.   textobj2 (vla-addtext modelspace text2 insertp2 height)
  29.    )
  30. )
  31.       )
  32.     )
  33.   )
  34. )
  35. (defun ml-length (ename / j d ptlist)
  36. (foreach n (entget ename)
  37. (if (= (car n) 11)
  38. (setq ptlist (cons (cdr n) ptlist))
  39. )
  40. )
  41. (reverse ptlist)
  42. (setq j 0 d 0)
  43. (repeat (1- (length ptlist))
  44. (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
  45.     (setq j (1+ j))
  46.   )
  47.   d
  48. )


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
 楼主| 发表于 2021-10-1 10:08:51 | 显示全部楼层
  1. (princ "\n程序:统计面积、长度 命令:tj")
  2. (defun C:tj (/ ss l i totalarea ename obj entarea)
  3.   (if (setq ss (ssget))
  4. (progn
  5. (vl-load-com)
  6. (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
  7.       (setq l (sslength ss) i 0 totalarea 0 totlength 0)
  8. (repeat l
  9. (setq ename (ssname ss i))
  10. (setq obj (vlax-ename->vla-object ename))
  11. (if (vlax-property-available-p obj "area")
  12. (setq totalarea (+ (vlax-get-property obj 'area) totalarea))
  13.         )
  14. (if (= (cdr (assoc 0 (entget ename))) "MLINE")
  15.    (setq totlength (+ totlength (ml-length ename)))
  16.    (setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
  17. )
  18.         (setq i (1+ i))
  19.       )
  20.       (setq text1 (strcat "总面积为: " (rtos (/ totalarea 1000000) 2 2) "平方米")
  21.      text2 (strcat "总长度为: " (rtos (/ totlength 1000) 2 3) "米")
  22.       )
  23.       (if (setq insertpt (getpoint "\n请输入文字插入点: "))
  24. (if (setq height (getdist "\n请输入文字高度:"))
  25.    (setq insertp1 (vlax-3d-point insertpt)
  26.   insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
  27.          textobj1 (vla-addtext modelspace text1 insertp1 height)
  28.   textobj2 (vla-addtext modelspace text2 insertp2 height)
  29.    )
  30. )
  31.       )
  32.     )
  33.   )
  34. )
  35. (defun ml-length (ename / j d ptlist)
  36. (foreach n (entget ename)
  37. (if (= (car n) 11)
  38. (setq ptlist (cons (cdr n) ptlist))
  39. )
  40. )
  41. (reverse ptlist)
  42. (setq j 0 d 0)
  43. (repeat (1- (length ptlist))
  44. (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
  45.     (setq j (1+ j))
  46.   )
  47.   d
  48. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 5295个

财富等级: 富甲天下

发表于 2021-10-2 16:09:44 | 显示全部楼层
修改这个代码真需要一些时间。

点评

在沙发回复的那个代码才是真正的代码,我觉得应该好修改吧,只不过是我不懂罢了  详情 回复 发表于 2021-10-2 18:19
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-10-2 18:19:14 | 显示全部楼层
tzfcn 发表于 2021-10-2 16:09
修改这个代码真需要一些时间。

在沙发回复的那个代码才是真正的代码,我觉得应该好修改吧,只不过是我不懂罢了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 541个

财富等级: 财运亨通

发表于 2021-10-6 09:55:26 | 显示全部楼层
判定默认的文字高度不合适的条件是什么?

点评

意思就是里面设置一个默认的文字高度,直接按空格或回车就按这个默认的高度写文字,如果想自定义高度还可以自己输入高度,再按空格或回车确认。可以么?  详情 回复 发表于 2021-10-6 11:28
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-10-6 11:28:48 | 显示全部楼层
lovezp 发表于 2021-10-6 09:55
判定默认的文字高度不合适的条件是什么?

意思就是里面设置一个默认的文字高度,直接按空格或回车就按这个默认的高度写文字,如果想自定义高度还可以自己输入高度,再按空格或回车确认。可以么?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 541个

财富等级: 财运亨通

发表于 2021-10-6 13:53:15 | 显示全部楼层
  1. (if (setq insertpt (getpoint "\n请输入文字插入点: "))
  2.         (if (setq height (getdist "\n请输入文字高度:"))
  3.           (progn
  4.             (setq insertp1 (vlax-3d-point insertpt)
  5.                   insertp2 (vlax-3d-point
  6.                              (polar insertpt (* 1.5 Pi) (* 1.5 height))
  7.                            )
  8.                   textobj1 (vla-addtext modelspace text1 insertp1 height)
  9.                   textobj2 (vla-addtext modelspace text2 insertp2 height)
  10.                   height_init height
  11.             )
  12.           )
  13.           (progn
  14.             (setq insertp1 (vlax-3d-point insertpt)
  15.                   insertp2 (vlax-3d-point
  16.                              (polar insertpt (* 1.5 Pi) (* 1.5 height_init))
  17.                            )
  18.                   textobj1 (vla-addtext modelspace text1 insertp1 height_init)
  19.                   textobj2 (vla-addtext modelspace text2 insertp2 height_init)
  20.             )
  21.           )
  22.         )
  23.       )

(princ "\n程序:统计面积、长度 命令:tj")
(setq height_init 100)

点评

非常感谢你,但是我的lisp水平很低,不知道怎么运用。还想麻烦你能弄个完整代码好么?就把默认的字高设置成1000就行。谢谢!  详情 回复 发表于 2021-10-7 11:07
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-10-7 11:07:52 | 显示全部楼层
lovezp 发表于 2021-10-6 13:53
(princ "\n程序:统计面积、长度 命令:tj")
(setq height_init 100)

非常感谢你,但是我的lisp水平很低,不知道怎么运用。还想麻烦你能弄个完整代码好么?就把默认的字高设置成1000就行。谢谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 541个

财富等级: 财运亨通

发表于 2021-10-7 14:05:48 | 显示全部楼层
复制粘贴都不愿意啊?这是有多懒

点评

大哥你好,我不是懒,而是不懂。我觉得你给我的代码是要替换我原先代码中的一些片段,是么?而我不知道怎么来弄。我只知道把代码复制粘贴到文本文档里面,然后保存成lsp格式的文件,然后CAD加载就可以用。我也就这个  详情 回复 发表于 2021-10-8 17:16
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-10-8 17:16:46 | 显示全部楼层
lovezp 发表于 2021-10-7 14:05
复制粘贴都不愿意啊?这是有多懒

大哥你好,我不是懒,而是不懂。我觉得你给我的代码是要替换我原先代码中的一些片段,是么?而我不知道怎么来弄。我只知道把代码复制粘贴到文本文档里面,然后保存成lsp格式的文件,然后CAD加载就可以用。我也就这个水平,还望大哥能帮帮忙
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 541个

财富等级: 财运亨通

发表于 2021-10-9 11:07:19 | 显示全部楼层
本帖最后由 lovezp 于 2021-10-10 09:45 编辑
  1. (princ "\n程序:统计面积、长度 命令:tj")
  2. (setq height_init 1000)
  3. (defun C:tj (/ ss l i totalarea ename obj entarea)
  4.   (if (setq ss (ssget))
  5.     (progn
  6.       (vl-load-com)
  7.       (setq modelspace
  8.        (vla-get-Modelspace
  9.          (vla-get-activeDocument (vlax-get-acad-object))
  10.        )
  11.       )
  12.       (setq l (sslength ss)
  13.       i 0
  14.       totalarea 0
  15.       totlength 0
  16.       )
  17.       (repeat l
  18.   (setq ename (ssname ss i))
  19.   (setq obj (vlax-ename->vla-object ename))
  20.   (if (vlax-property-available-p obj "area")
  21.     (setq totalarea (+ (vlax-get-property obj 'area) totalarea))
  22.   )
  23.   (if (= (cdr (assoc 0 (entget ename))) "MLINE")
  24.     (setq totlength (+ totlength (ml-length ename)))
  25.     (setq  totlength (+ totlength
  26.            (vlax-curve-getdistatparam
  27.              ename
  28.              (vlax-curve-getendparam ename)
  29.            )
  30.         )
  31.     )
  32.   )
  33.   (setq i (1+ i))
  34.       )
  35.       (setq text1 (strcat "总面积为: "
  36.         (rtos (/ totalarea 1000000) 2 2)
  37.         "平方米"
  38.       )
  39.       text2 (strcat "总长度为: " (rtos (/ totlength 1000) 2 3) "米")
  40.       )
  41.       (if (setq insertpt (getpoint "\n请输入文字插入点: "))
  42.   (if (setq height (getdist "\n请输入文字高度:"))
  43.     (progn (setq insertp1     (vlax-3d-point insertpt)
  44.            insertp2     (vlax-3d-point
  45.              (polar insertpt (* 1.5 Pi) (* 1.5 height))
  46.            )
  47.            textobj1     (vla-addtext modelspace text1 insertp1 height)
  48.            textobj2     (vla-addtext modelspace text2 insertp2 height)
  49.            height_init height
  50.      )
  51.     )
  52.     (progn (setq insertp1  (vlax-3d-point insertpt)
  53.            insertp2  (vlax-3d-point
  54.           (polar insertpt (* 1.5 Pi) (* 1.5 height_init))
  55.         )
  56.            textobj1  (vla-addtext
  57.           modelspace
  58.           text1
  59.           insertp1
  60.           height_init
  61.         )
  62.            textobj2  (vla-addtext
  63.           modelspace
  64.           text2
  65.           insertp2
  66.           height_init
  67.         )
  68.      )
  69.     )
  70.   )
  71.       )
  72.     )
  73.   )
  74.   (princ)
  75. )
  76. (defun ml-length (ename / j d ptlist)
  77. (foreach n (entget ename)
  78. (if (= (car n) 11)
  79. (setq ptlist (cons (cdr n) ptlist))
  80. )
  81. )
  82. (reverse ptlist)
  83. (setq j 0 d 0)
  84. (repeat (1- (length ptlist))
  85. (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
  86.   (setq j (1+ j))
  87. )
  88. d
  89. )

点评

谢谢大哥,我用了一下可以用。但是还有一个小问题,大哥你编写的这个代码只能点选1个对象,而不能框选好几个对象。这个怎么再修改一下呢?  详情 回复 发表于 2021-10-10 09:33
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-10-10 09:33:24 | 显示全部楼层

谢谢大哥,我用了一下可以用。但是还有一个小问题,大哥你编写的这个代码只能点选1个对象,而不能框选好几个对象。这个怎么再修改一下呢?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 541个

财富等级: 财运亨通

发表于 2021-10-10 09:37:49 | 显示全部楼层
本帖最后由 lovezp 于 2021-10-10 09:46 编辑

你要算总面积。。。改回你原来的了

点评

嗯嗯,明白了大哥。对于CAD插入进去的图片怎么来修改(就简单的修改,照片边框的四个点可以往外或往里拖),大哥你有妙招么?  详情 回复 发表于 2021-10-11 11:41
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-10-11 11:41:58 | 显示全部楼层
lovezp 发表于 2021-10-10 09:37
你要算总面积。。。改回你原来的了

嗯嗯,明白了大哥。对于CAD插入进去的图片怎么来修改(就简单的修改,照片边框的四个点可以往外或往里拖),大哥你有妙招么?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 541个

财富等级: 财运亨通

发表于 2021-10-11 13:19:29 | 显示全部楼层
没有,基本不插图片
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-12-25 16:05 , Processed in 0.467285 second(s), 57 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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