统计

hphkjz · 发表于 2021-10-1 10:07:39

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

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

×

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

(princ "\n程序：统计面积、长度命令：tj")
(defun C:tj (/ ss l i totalarea ename obj entarea)
(if (setq ss (ssget))
(progn
(vl-load-com)
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
(setq l (sslength ss) i 0 totalarea 0 totlength 0)
(repeat l
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq totalarea (+ (vlax-get-property obj 'area) totalarea))
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq totlength (+ totlength (ml-length ename)))
(setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
)
(setq i (1+ i))
)
(setq text1 (strcat "总面积为: " (rtos (/ totalarea 1000000) 2 2) "平方米")
text2 (strcat "总长度为: " (rtos (/ totlength 1000) 2 3) "米")
)
(if (setq insertpt (getpoint "\n请输入文字插入点: "))
(if (setq height (getdist "\n请输入文字高度:"))
(setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
textobj1 (vla-addtext modelspace text1 insertp1 height)
textobj2 (vla-addtext modelspace text2 insertp2 height)
)
)
)
)
)
)
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
(setq j 0 d 0)
(repeat (1- (length ptlist))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
(setq j (1+ j))
)
d
)

(princ "\n程序：统计面积、长度 命令：tj") 
(defun C:tj (/ ss l i totalarea ename obj entarea) 
  (if (setq ss (ssget)) 
(progn 
(vl-load-com) 
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object)))) 
      (setq l (sslength ss) i 0 totalarea 0 totlength 0) 
(repeat l 
(setq ename (ssname ss i)) 
(setq obj (vlax-ename->vla-object ename)) 
(if (vlax-property-available-p obj "area") 
(setq totalarea (+ (vlax-get-property obj 'area) totalarea)) 
        ) 
(if (= (cdr (assoc 0 (entget ename))) "MLINE") 
   (setq totlength (+ totlength (ml-length ename))) 
   (setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename)))) 
) 
        (setq i (1+ i)) 
      ) 
      (setq text1 (strcat "总面积为: " (rtos (/ totalarea 1000000) 2 2) "平方米") 
     text2 (strcat "总长度为: " (rtos (/ totlength 1000) 2 3) "米") 
      ) 
      (if (setq insertpt (getpoint "\n请输入文字插入点: ")) 
(if (setq height (getdist "\n请输入文字高度:")) 
   (setq insertp1 (vlax-3d-point insertpt) 
  insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height))) 
         textobj1 (vla-addtext modelspace text1 insertp1 height) 
  textobj2 (vla-addtext modelspace text2 insertp2 height) 
   ) 
) 
      ) 
    ) 
  ) 
) 
(defun ml-length (ename / j d ptlist) 
(foreach n (entget ename) 
(if (= (car n) 11) 
(setq ptlist (cons (cdr n) ptlist)) 
) 
) 
(reverse ptlist) 
(setq j 0 d 0) 
(repeat (1- (length ptlist)) 
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist)))) 
    (setq j (1+ j)) 
  ) 
  d 
)

hphkjz · 发表于 2021-10-1 10:08:51

(princ "\n程序：统计面积、长度命令：tj")
(defun C:tj (/ ss l i totalarea ename obj entarea)
(if (setq ss (ssget))
(progn
(vl-load-com)
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
(setq l (sslength ss) i 0 totalarea 0 totlength 0)
(repeat l
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq totalarea (+ (vlax-get-property obj 'area) totalarea))
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq totlength (+ totlength (ml-length ename)))
(setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
)
(setq i (1+ i))
)
(setq text1 (strcat "总面积为: " (rtos (/ totalarea 1000000) 2 2) "平方米")
text2 (strcat "总长度为: " (rtos (/ totlength 1000) 2 3) "米")
)
(if (setq insertpt (getpoint "\n请输入文字插入点: "))
(if (setq height (getdist "\n请输入文字高度:"))
(setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
textobj1 (vla-addtext modelspace text1 insertp1 height)
textobj2 (vla-addtext modelspace text2 insertp2 height)
)
)
)
)
)
)
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
(setq j 0 d 0)
(repeat (1- (length ptlist))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
(setq j (1+ j))
)
d
)

(princ "\n程序：统计面积、长度 命令：tj") 
(defun C:tj (/ ss l i totalarea ename obj entarea) 
  (if (setq ss (ssget)) 
(progn 
(vl-load-com) 
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object)))) 
      (setq l (sslength ss) i 0 totalarea 0 totlength 0) 
(repeat l 
(setq ename (ssname ss i)) 
(setq obj (vlax-ename->vla-object ename)) 
(if (vlax-property-available-p obj "area") 
(setq totalarea (+ (vlax-get-property obj 'area) totalarea)) 
        ) 
(if (= (cdr (assoc 0 (entget ename))) "MLINE") 
   (setq totlength (+ totlength (ml-length ename))) 
   (setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename)))) 
) 
        (setq i (1+ i)) 
      ) 
      (setq text1 (strcat "总面积为: " (rtos (/ totalarea 1000000) 2 2) "平方米") 
     text2 (strcat "总长度为: " (rtos (/ totlength 1000) 2 3) "米") 
      ) 
      (if (setq insertpt (getpoint "\n请输入文字插入点: ")) 
(if (setq height (getdist "\n请输入文字高度:")) 
   (setq insertp1 (vlax-3d-point insertpt) 
  insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height))) 
         textobj1 (vla-addtext modelspace text1 insertp1 height) 
  textobj2 (vla-addtext modelspace text2 insertp2 height) 
   ) 
) 
      ) 
    ) 
  ) 
) 
(defun ml-length (ename / j d ptlist) 
(foreach n (entget ename) 
(if (= (car n) 11) 
(setq ptlist (cons (cdr n) ptlist)) 
) 
) 
(reverse ptlist) 
(setq j 0 d 0) 
(repeat (1- (length ptlist)) 
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist)))) 
    (setq j (1+ j)) 
  ) 
  d 
)

tzfcn · 发表于 2021-10-2 16:09:44

修改这个代码真需要一些时间。

hphkjz · 发表于 2021-10-2 18:19:14

tzfcn 发表于 2021-10-2 16:09
修改这个代码真需要一些时间。

在沙发回复的那个代码才是真正的代码，我觉得应该好修改吧，只不过是我不懂罢了

lovezp · 发表于 2021-10-6 09:55:26

判定默认的文字高度不合适的条件是什么？

hphkjz · 发表于 2021-10-6 11:28:48

lovezp 发表于 2021-10-6 09:55
判定默认的文字高度不合适的条件是什么？

意思就是里面设置一个默认的文字高度，直接按空格或回车就按这个默认的高度写文字，如果想自定义高度还可以自己输入高度，再按空格或回车确认。可以么？

lovezp · 发表于 2021-10-6 13:53:15

(if (setq insertpt (getpoint "\n请输入文字插入点: "))
(if (setq height (getdist "\n请输入文字高度:"))
(progn
(setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point
(polar insertpt (* 1.5 Pi) (* 1.5 height))
)
textobj1 (vla-addtext modelspace text1 insertp1 height)
textobj2 (vla-addtext modelspace text2 insertp2 height)
height_init height
)
)
(progn
(setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point
(polar insertpt (* 1.5 Pi) (* 1.5 height_init))
)
textobj1 (vla-addtext modelspace text1 insertp1 height_init)
textobj2 (vla-addtext modelspace text2 insertp2 height_init)
)
)
)
)

(if (setq insertpt (getpoint "\n请输入文字插入点: ")) 
        (if (setq height (getdist "\n请输入文字高度:")) 
          (progn 
            (setq insertp1 (vlax-3d-point insertpt) 
                  insertp2 (vlax-3d-point 
                             (polar insertpt (* 1.5 Pi) (* 1.5 height)) 
                           ) 
                  textobj1 (vla-addtext modelspace text1 insertp1 height) 
                  textobj2 (vla-addtext modelspace text2 insertp2 height) 
                  height_init height 
            ) 
          ) 
          (progn 
            (setq insertp1 (vlax-3d-point insertpt) 
                  insertp2 (vlax-3d-point 
                             (polar insertpt (* 1.5 Pi) (* 1.5 height_init)) 
                           ) 
                  textobj1 (vla-addtext modelspace text1 insertp1 height_init) 
                  textobj2 (vla-addtext modelspace text2 insertp2 height_init) 
            ) 
          ) 
        ) 
      )

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

hphkjz · 发表于 2021-10-7 11:07:52

lovezp 发表于 2021-10-6 13:53
(princ "\n程序：统计面积、长度命令：tj")
(setq height_init 100)

非常感谢你，但是我的lisp水平很低，不知道怎么运用。还想麻烦你能弄个完整代码好么？就把默认的字高设置成1000就行。谢谢！

lovezp · 发表于 2021-10-7 14:05:48

复制粘贴都不愿意啊？这是有多懒

hphkjz · 发表于 2021-10-8 17:16:46

lovezp 发表于 2021-10-7 14:05
复制粘贴都不愿意啊？这是有多懒

大哥你好，我不是懒，而是不懂。我觉得你给我的代码是要替换我原先代码中的一些片段，是么？而我不知道怎么来弄。我只知道把代码复制粘贴到文本文档里面，然后保存成lsp格式的文件，然后CAD加载就可以用。我也就这个水平，还望大哥能帮帮忙

lovezp · 发表于 2021-10-9 11:07:19

本帖最后由 lovezp 于 2021-10-10 09:45 编辑

(princ "\n程序：统计面积、长度命令：tj")
(setq height_init 1000)
(defun C:tj (/ ss l i totalarea ename obj entarea)
(if (setq ss (ssget))
(progn
(vl-load-com)
(setq modelspace
(vla-get-Modelspace
(vla-get-activeDocument (vlax-get-acad-object))
)
)
(setq l (sslength ss)
i 0
totalarea 0
totlength 0
)
(repeat l
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq totalarea (+ (vlax-get-property obj 'area) totalarea))
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq totlength (+ totlength (ml-length ename)))
(setq totlength (+ totlength
(vlax-curve-getdistatparam
ename
(vlax-curve-getendparam ename)
)
)
)
)
(setq i (1+ i))
)
(setq text1 (strcat "总面积为: "
(rtos (/ totalarea 1000000) 2 2)
"平方米"
)
text2 (strcat "总长度为: " (rtos (/ totlength 1000) 2 3) "米")
)
(if (setq insertpt (getpoint "\n请输入文字插入点: "))
(if (setq height (getdist "\n请输入文字高度:"))
(progn (setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point
(polar insertpt (* 1.5 Pi) (* 1.5 height))
)
textobj1 (vla-addtext modelspace text1 insertp1 height)
textobj2 (vla-addtext modelspace text2 insertp2 height)
height_init height
)
)
(progn (setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point
(polar insertpt (* 1.5 Pi) (* 1.5 height_init))
)
textobj1 (vla-addtext
modelspace
text1
insertp1
height_init
)
textobj2 (vla-addtext
modelspace
text2
insertp2
height_init
)
)
)
)
)
)
)
(princ)
)
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
(setq j 0 d 0)
(repeat (1- (length ptlist))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
(setq j (1+ j))
)
d
)

(princ "\n程序：统计面积、长度 命令：tj") 
(setq height_init 1000) 
(defun C:tj (/ ss l i totalarea ename obj entarea) 
  (if (setq ss (ssget)) 
    (progn 
      (vl-load-com) 
      (setq modelspace 
       (vla-get-Modelspace 
         (vla-get-activeDocument (vlax-get-acad-object)) 
       ) 
      ) 
      (setq l (sslength ss) 
      i 0 
      totalarea 0 
      totlength 0 
      ) 
      (repeat l 
  (setq ename (ssname ss i)) 
  (setq obj (vlax-ename->vla-object ename)) 
  (if (vlax-property-available-p obj "area") 
    (setq totalarea (+ (vlax-get-property obj 'area) totalarea)) 
  ) 
  (if (= (cdr (assoc 0 (entget ename))) "MLINE") 
    (setq totlength (+ totlength (ml-length ename))) 
    (setq  totlength (+ totlength 
           (vlax-curve-getdistatparam 
             ename 
             (vlax-curve-getendparam ename) 
           ) 
        ) 
    ) 
  ) 
  (setq i (1+ i)) 
      ) 
      (setq text1 (strcat "总面积为: " 
        (rtos (/ totalarea 1000000) 2 2) 
        "平方米" 
      ) 
      text2 (strcat "总长度为: " (rtos (/ totlength 1000) 2 3) "米") 
      ) 
      (if (setq insertpt (getpoint "\n请输入文字插入点: ")) 
  (if (setq height (getdist "\n请输入文字高度:")) 
    (progn (setq insertp1     (vlax-3d-point insertpt) 
           insertp2     (vlax-3d-point 
             (polar insertpt (* 1.5 Pi) (* 1.5 height)) 
           ) 
           textobj1     (vla-addtext modelspace text1 insertp1 height) 
           textobj2     (vla-addtext modelspace text2 insertp2 height) 
           height_init height 
     ) 
    ) 
    (progn (setq insertp1  (vlax-3d-point insertpt) 
           insertp2  (vlax-3d-point 
          (polar insertpt (* 1.5 Pi) (* 1.5 height_init)) 
        ) 
           textobj1  (vla-addtext 
          modelspace 
          text1 
          insertp1 
          height_init 
        ) 
           textobj2  (vla-addtext 
          modelspace 
          text2 
          insertp2 
          height_init 
        ) 
     ) 
    ) 
  ) 
      ) 
    ) 
  ) 
  (princ) 
) 
(defun ml-length (ename / j d ptlist) 
(foreach n (entget ename) 
(if (= (car n) 11) 
(setq ptlist (cons (cdr n) ptlist)) 
) 
) 
(reverse ptlist) 
(setq j 0 d 0) 
(repeat (1- (length ptlist)) 
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist)))) 
  (setq j (1+ j)) 
) 
d 
)

hphkjz · 发表于 2021-10-10 09:33:24

lovezp 发表于 2021-10-9 11:07

谢谢大哥，我用了一下可以用

。但是还有一个小问题，大哥你编写的这个代码只能点选1个对象，而不能框选好几个对象。这个怎么再修改一下呢？

lovezp · 发表于 2021-10-10 09:37:49

本帖最后由 lovezp 于 2021-10-10 09:46 编辑

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

hphkjz · 发表于 2021-10-11 11:41:58

lovezp 发表于 2021-10-10 09:37
你要算总面积。。。改回你原来的了

嗯嗯，明白了大哥。对于CAD插入进去的图片怎么来修改（就简单的修改，照片边框的四个点可以往外或往里拖），大哥你有妙招么？

lovezp · 发表于 2021-10-11 13:19:29

没有，基本不插图片

账号		自动登录	找回密码
密码			立即注册

[编程申请] 统计

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

点评

点评

点评

点评

点评

点评