wgij007 发表于 2019-11-4 14:01:43

求一个线段长度总和与生成文本

(defun C:W-ay (/ CURVE TLEN SS N SUMLEN)
(vl-load-com)
(setq SUMLEN 0)
(setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
(setq N 0)
(repeat (sslength SS)
(setq CURVE (vlax-ename->vla-object (ssname SS N)))
(setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE)))
(setq SUMLEN (+ SUMLEN TLEN))
(setq N (1+ N))
)
(princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 3) " mm"))
(princ)
)




wgij007 发表于 2019-11-4 14:02:33

像这种
;;;;;计算面积，周长。显视在图面上
(defun C:am (/ s text1 text2 ss l i totalarea ename obj insertpt insertpt1)
      (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 2 2) " mm2")
                              text2 (strcat "总长度为: " (rtos totlength 2 2) " mm")
                        )
                        (setq insertpt (nth 1(grread 5)))
                        (setq insertpt1 (polar insertpt (* 1.5 pi) (* (getvar "DIMSCALE") 7.0)))
                        (entmake (list '(0 . "TEXT") (cons 1 text1) (cons 8 "PUB_TEXT") (cons 10 insertpt) (cons 40 (* (getvar "DIMSCALE") 5.0))))
                        (setq s(ssadd))
                        (ssadd (entlast) s)
                        (entmake (list '(0 . "TEXT") (cons 1 text2) (cons 8 "PUB_TEXT") (cons 10 insertpt1) (cons 40 (* (getvar "DIMSCALE") 5.0))))
                        (ssadd (entlast) s)
                        (command "MOVE" s ""insertpt)
                )
      )
)
(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
)

wgij007 发表于 2019-11-4 18:43:20

那位老大能帮帮吗

chenqiang26 发表于 2019-11-6 18:38:37

本帖最后由 chenqiang26 于 2019-11-6 18:49 编辑

(defun C:Ww (/ dxdx pt1 text1 CURVE TLEN SS N SUMLEN)
(vl-load-com)
(setq SUMLEN 0)
(setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
(setq N 0)
(repeat (sslength SS)
(setq CURVE (vlax-ename->vla-object (ssname SS N)))
(setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE)))
(setq SUMLEN (+ SUMLEN TLEN))
(setq N (1+ N))
)
(setq text1 (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 3) " mm"))
(princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 3) " mm"))
        (setq dxdx (fix (/ SUMLEN (sslength SS) 100)))
        (setq pt1 (getpoint "\n 选择一个插入点"))
        (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText")
                        '(7 . "c-c") (cons 5"44F") (cons 40 dxdx)
                        (cons 1 text1) (cons 10 pt1)))
(princ)
)
新手一枚，只能做到这个地步了 - - ，

wgij007 发表于 2019-11-7 18:11:35

chenqiang26 发表于 2019-11-6 18:38
(defun C:Ww (/ dxdx pt1 text1 CURVE TLEN SS N SUMLEN)
(vl-load-com)
(setq SUMLEN 0)


太感谢你了，这是我想要的，谢谢
页: [1]
查看完整版本: 求一个线段长度总和与生成文本