修改CAD测量面积、长度的LSP代码
发布网友
发布时间:2022-05-01 12:35
我来回答
共3个回答
热心网友
时间:2023-10-12 13:33
;单独做一个程序amset设置字高,再把单位改一下就行了
(defun C:amset()
(setq height (getdist "\n请输入文字高度:"))
(PRINC))
(defun C:am (/ 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))
;;(vlax-mp-object obj T)
(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 4) "平方米")
text2 (strcat "长度为: " (rtos (/ totlength 1000) 2 4) "米")
)
(if (setq insertpt (getpoint "\n请输入文字插入点: "))
(if height
(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
)
热心网友
时间:2023-10-12 13:34
使用下面的autolisp代码统计面积:
(defun c:mj ( / &k1 &kw1 a1 a2 ss1);统计面积
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-mp-object) (vl-load-com) );加载vlax函数
(princ "\n请选择要计算面积的对象")
(if (setq &kw1 (ssget '((0 . "POLYLINE,LWPOLYLINE,CIRCLE,ELLIPSE,SPLINE,REGION"))))
(progn
(setq ss1 '() a1 0.0)
(while (setq &k1 (ssname &kw1 0))
(setq &kw1 (ssdel &k1 &kw1))
(if (and
(setq &k1 (vlax-ename->vla-object &k1));转换为vlax对象
(null (vl-catch-all-error-p (setq a2 (vl-catch-all-apply 'vla-get-area (list &k1)))))
);计算面积
(progn
(setq a1 (+ a1 a2));总面积
(setq a2 (rtos a2))
(if (car ss1)
(setq ss1 (append ss1 (list "+" a2)));计算公式
(setq ss1 (cons a2 ss1))
)
)
)
);while
(princ "\n对象总面积:")
(princ (rtos a1)) (princ " 平方毫米")
(princ "\n计算公式为:")
(princ (apply 'strcat ss1));显示计算公式
)
)
(princ)
)追问你这个还是以毫米为单位的,而且只能测量面积,我的那个代码可以同时测面积与长度。
热心网友
时间:2023-10-12 13:34
那个代码的单个面积或周长结果就是m2(平方米)、m(米)的啊,只是总面积和总周长不对的,你要结果乘以一个系数做什么用啊?
热心网友
时间:2023-10-12 13:33
;单独做一个程序amset设置字高,再把单位改一下就行了
(defun C:amset()
(setq height (getdist "\n请输入文字高度:"))
(PRINC))
(defun C:am (/ 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))
;;(vlax-mp-object obj T)
(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 4) "平方米")
text2 (strcat "长度为: " (rtos (/ totlength 1000) 2 4) "米")
)
(if (setq insertpt (getpoint "\n请输入文字插入点: "))
(if height
(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
)
热心网友
时间:2023-10-12 13:34
使用下面的autolisp代码统计面积:
(defun c:mj ( / &k1 &kw1 a1 a2 ss1);统计面积
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-mp-object) (vl-load-com) );加载vlax函数
(princ "\n请选择要计算面积的对象")
(if (setq &kw1 (ssget '((0 . "POLYLINE,LWPOLYLINE,CIRCLE,ELLIPSE,SPLINE,REGION"))))
(progn
(setq ss1 '() a1 0.0)
(while (setq &k1 (ssname &kw1 0))
(setq &kw1 (ssdel &k1 &kw1))
(if (and
(setq &k1 (vlax-ename->vla-object &k1));转换为vlax对象
(null (vl-catch-all-error-p (setq a2 (vl-catch-all-apply 'vla-get-area (list &k1)))))
);计算面积
(progn
(setq a1 (+ a1 a2));总面积
(setq a2 (rtos a2))
(if (car ss1)
(setq ss1 (append ss1 (list "+" a2)));计算公式
(setq ss1 (cons a2 ss1))
)
)
)
);while
(princ "\n对象总面积:")
(princ (rtos a1)) (princ " 平方毫米")
(princ "\n计算公式为:")
(princ (apply 'strcat ss1));显示计算公式
)
)
(princ)
)追问你这个还是以毫米为单位的,而且只能测量面积,我的那个代码可以同时测面积与长度。
热心网友
时间:2023-10-12 13:34
那个代码的单个面积或周长结果就是m2(平方米)、m(米)的啊,只是总面积和总周长不对的,你要结果乘以一个系数做什么用啊?