如何获取图元信息

xiao88gang

LISP如何能获取所选图元的长和宽，以及所选线段的总长。并复制到粘贴板上，以便调用。谢谢。

htlaser

按要求重修改:框选   

guosheyang

长  宽 是指啥  比如  圆 椭圆  样条线等  

672505821

entget(car(entsel))?:o

htlaser

• 

  1. ;============================================================================================================================
     
  2. (defun c:test (/ cp ent len plst txt txt2  x0 x1 xx y0 y1 yy )
     
  3.   (vl-load-com)  
     
  4.   (defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
     
  5.     (and (= (type STR) 'STR)
     
  6.       (setq HTML (vlax-create-object "htmlfile"))
     
  7.       (setq RESULT (vlax-invoke   (vlax-get  (vlax-get HTML 'PARENTWINDOW)   'CLIPBOARDDATA )  'SETDATA   "Text"   STR ))
     
  8.       (vlax-release-object HTML)))   
     
  9.   (setq ent (car (entsel "\n请指定一条多段线")))  
     
  10.   (setq len  (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))
      
  11.   (setq plst(mapcar 'cdr (vl-remove-if (function (lambda (e)(/= 10 (car e)))) (entget ent))))
      
  12.   (setq x0 (car (vl-sort (mapcar 'car  plst) (function (lambda(e1 e2)(< e1 e2))))))
      
  13.   (setq X1 (car (vl-sort (mapcar 'car  plst) (function (lambda(e1 e2)(> e1 e2))))))
      
  14.   (setq y0 (car (vl-sort (mapcar 'cadr plst) (function (lambda(e1 e2)(< e1 e2))))))
      
  15.   (setq y1 (car (vl-sort (mapcar 'cadr plst) (function (lambda(e1 e2)(> e1 e2))))))
      
  16.   (setq cp (mapcar '(lambda(x y) (/ (+ x y) 2.0)) (list x0 y0)(list x1 y1)))
      
  17.   (setq xx (rtos (- x1 x0)2 3))  
      
  18.   (setq yy (rtos (- y1 y0)2 3))  
      
  19.   (setq txt(strcat "线段总长="(rtos  len 2 3)"mm" "  "   "X="xx"mm" "  " "Y="yy"mm" ))  
      
  20.   (ZML-CLIP-SETSTRING txt)
      
  21.   (princ "\n ")
      
  22.   (setq txt2 (strcat  "复制成功:" "线段总长="(rtos  len 2 3)"mm" "  "   "X="xx"mm" "  " "Y="yy"mm" ))  
      
  23.   (princ txt2)  
      
  24.   (princ )
      
  25. )   
      
  26. 
      
  27. ;============================================================================================================================
      
  28. (defun c:test2 (/ ent len obj p1 p2 txt txt2 x y)
      
  29.   (vl-load-com)  
      
  30.   (defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
      
  31.     (and (= (type STR) 'STR)
      
  32.       (setq HTML (vlax-create-object "htmlfile"))
      
  33.       (setq RESULT (vlax-invoke   (vlax-get  (vlax-get HTML 'PARENTWINDOW)   'CLIPBOARDDATA )  'SETDATA   "Text"   STR ))
      
  34.       (vlax-release-object HTML)))   
      
  35.   (setq ent (car (entsel "\n请获取一个对象")))  
      
  36.   (setq len  (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))
      
  37.   (setq obj (vlax-ename->vla-object ent))
      
  38.   (vla-GetBoundingBox obj 'p1 'p2 )
      
  39.   (setq p1 (vlax-safearray->list p1))
      
  40.   (setq p2 (vlax-safearray->list p2))
      
  41.   (setq X (rtos (abs (- (car p1)  (car  p2))) 2 3))        
      
  42.   (setq Y (rtos (abs (- (cadr p1) (cadr p2))) 2 3))        
      
  43.   (setq txt(strcat "线段总长="(rtos  len 2 3)"mm" "  "   "X="X"mm" "  " "Y="Y"mm" ))  
      
  44.   (ZML-CLIP-SETSTRING txt)
      
  45.   (princ "\n ")
      
  46.   (setq txt2 (strcat  "复制成功:" "线段总长="(rtos  len 2 3)"mm" "  "   "X="X"mm" "  " "Y="Y"mm" ))  
      
  47.   (princ txt2)  
      
  48.   (princ )
      
  49. )
      
  50. 
      
  51. ;============================================================================================================================

  ;============================================================================================================================<br /> (defun c:test (/ cp ent len plst txt txt2  x0 x1 xx y0 y1 yy )<br />   (vl-load-com)  <br />   (defun ZML-CLIP-SETSTRING (STR / HTML RESULT)<br />     (and (= (type STR) 'STR)<br />       (setq HTML (vlax-create-object "htmlfile"))<br />       (setq RESULT (vlax-invoke   (vlax-get  (vlax-get HTML 'PARENTWINDOW)   'CLIPBOARDDATA )  'SETDATA   "Text"   STR ))<br />       (vlax-release-object HTML)))    <br />   (setq ent (car (entsel "\n请指定一条多段线")))  <br />   (setq len  (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))<br />   (setq plst(mapcar 'cdr (vl-remove-if (function (lambda (e)(/= 10 (car e)))) (entget ent))))<br />   (setq x0 (car (vl-sort (mapcar 'car  plst) (function (lambda(e1 e2)(< e1 e2))))))<br />   (setq X1 (car (vl-sort (mapcar 'car  plst) (function (lambda(e1 e2)(> e1 e2))))))<br />   (setq y0 (car (vl-sort (mapcar 'cadr plst) (function (lambda(e1 e2)(< e1 e2))))))<br />   (setq y1 (car (vl-sort (mapcar 'cadr plst) (function (lambda(e1 e2)(> e1 e2))))))<br />   (setq cp (mapcar '(lambda(x y) (/ (+ x y) 2.0)) (list x0 y0)(list x1 y1)))<br />   (setq xx (rtos (- x1 x0)2 3))  <br />   (setq yy (rtos (- y1 y0)2 3))  <br />   (setq txt(strcat "线段总长="(rtos  len 2 3)"mm" "  "   "X="xx"mm" "  " "Y="yy"mm" ))  <br />   (ZML-CLIP-SETSTRING txt)<br />   (princ "\n ")<br />   (setq txt2 (strcat  "复制成功:" "线段总长="(rtos  len 2 3)"mm" "  "   "X="xx"mm" "  " "Y="yy"mm" ))  <br />   (princ txt2)  <br />   (princ )<br /> )   <br /> <br /> ;============================================================================================================================<br /> (defun c:test2 (/ ent len obj p1 p2 txt txt2 x y)<br />   (vl-load-com)  <br />   (defun ZML-CLIP-SETSTRING (STR / HTML RESULT)<br />     (and (= (type STR) 'STR)<br />       (setq HTML (vlax-create-object "htmlfile"))<br />       (setq RESULT (vlax-invoke   (vlax-get  (vlax-get HTML 'PARENTWINDOW)   'CLIPBOARDDATA )  'SETDATA   "Text"   STR ))<br />       (vlax-release-object HTML)))    <br />   (setq ent (car (entsel "\n请获取一个对象")))  <br />   (setq len  (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))<br />   (setq obj (vlax-ename->vla-object ent)) <br />   (vla-GetBoundingBox obj 'p1 'p2 ) <br />   (setq p1 (vlax-safearray->list p1)) <br />   (setq p2 (vlax-safearray->list p2)) <br />   (setq X (rtos (abs (- (car p1)  (car  p2))) 2 3))        <br />   (setq Y (rtos (abs (- (cadr p1) (cadr p2))) 2 3))        <br />   (setq txt(strcat "线段总长="(rtos  len 2 3)"mm" "  "   "X="X"mm" "  " "Y="Y"mm" ))  <br />   (ZML-CLIP-SETSTRING txt)<br />   (princ "\n ")<br />   (setq txt2 (strcat  "复制成功:" "线段总长="(rtos  len 2 3)"mm" "  "   "X="X"mm" "  " "Y="Y"mm" ))  <br />   (princ txt2)  <br />   (princ )<br /> )<br /> <br /> ;============================================================================================================================
  
  

azbd

题目不清楚

wzg356

搜动态信息查询

xiao88gang

htlaser 发表于 2022-3-2 17:28

可能我没有说清楚，不是单选，要框选。附图如下。

seamopan

很好的东西
学习

xiao88gang

htlaser 发表于 2022-3-2 10:44
按要求重修改:框选

如果想把精度精确下个位，四舍五入。可能实现？还有就是想把总线长度放在 长宽的后面。