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

wgij007

(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

像这种
;;;;;计算面积，周长。显视在图面上
(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

那位老大能帮帮吗

chenqiang26

(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

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

太感谢你了，这是我想要的，谢谢