如何动态显示多段线长度

烟盒迷唇

以下为动态显示直线长度的代码，如何改成多段线也能显示动态长度呢？因为有2个组码10，想来想去不知道怎么修改，特求助各位大神。

2. (defun c:hddx( / cood d1 d2 data1 data3 data4 en1 en3 en4 gr loop pt1 ptb)
   
3.   ;动态显示线段的总长度。 by fl202   2018.1.31
   
4.   (setvar "cmdecho" 0)  
   
5.   (setq d1 0 pt1 (getpoint "\n 动态显示线段的总长度,请确定起点："))
   
6.   (entmake (list '(0 . "line")  (cons 62 2)  (cons 10 pt1) (cons 11 (polar pt1 0 100) ) ) )
   
7.   (setq en1 (entlast)   data1 (entget en1)  )  
   
8.   (entmake (list '(0 . "TEXT") (cons 1 (strcat "总长度=" (rtos d1 2 3))) (cons 10 (polar pt1 (* pi 0.5) 10) ) (cons 40 4 )(cons 41 0.75 ) (cons 62 3)))
   
9.   (setq en3 (entlast)   data3 (entget en3)  )
   
10.   (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 11 pt1) (cons 40 4 ) (cons 41 0.75 )(cons 62 3) (cons 71 0) (cons 72 1) (cons 73 2)))
    
11.   (setq en4 (entlast)   data4 (entget en4)  )
    
12.   (setq  loop T)
    
13.   (while loop
    
14.     (setq gr (grread T 8))
    
15.     (setq cood (car gr)  ptb (cadr gr))
    
16.     (cond
    
17.       ((= cood 3) ;;; 鼠标左键
    
18.         (progn
    
19.           ;(entmake (list '(0 . "TEXT") (cons 1 ftxt1) (cons 10 ptb) (cons 40 h) (cons 62 211) (cons 7 "info")   ))         
    
20.           (setq pt1 ptb)
    
21.           (entmake (list '(0 . "line")  (cons 62 2)  (cons 10 pt1) (cons 11 (polar pt1 0 100) ) ) )
    
22.           (setq en1 (entlast)   data1 (entget en1)  d1 (+ d1 d2) )
    
23.           (setq data3 (subst (cons 1  (strcat "总长度=" (rtos d1 2 3))  ) (assoc 1 data3) data3))
    
24.           (entmod data3)
    
25.           (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 11 pt1) (cons 40 4 )(cons 41 0.75 ) (cons 62 3) (cons 71 0) (cons 72 1) (cons 73 2)  ))
    
26.           (setq en4 (entlast)   data4 (entget en4)  )
    
27.           ;(setq loop nil)
    
28.         ));;; 鼠标左键
    
29.       ((= cood 11) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为回车时
    
30.       ((= cood 25) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为屏幕菜单时
    
31.       ((equal gr '(2 32)) (setq loop nil)(entdel en1)(entdel en4))               ;;; 空格键
    
32.       
    
33.       ( (= cood 5)  ;;; 鼠标移动
    
34.         (progn              
    
35.           ;(setq data1 (subst (cons 10 pt1) (assoc 10 data1) data1))
    
36.           (setq pt2 (cdr (assoc 10 data1))  data1 (subst (cons 11 ptb) (assoc 11 data1) data1))           
    
37.           (entmod data1)   
    
38.           ;(setq d2 (distance pt1 ptb)  midp (list (/ (+ (car pt2) (car ptb) )  2.0)  (/ (+ (cadr pt2) (cadr ptb) )  2.0)   )  ag1 (+ (angle pt2 ptb) (* pi 0.5))  )
    
39.           (setq d2 (distance pt1 ptb)  ag1 (+ (angle pt2 ptb) 0)  )
    
40.           (cond
    
41.             ((< (* pi 0.5) (angle pt2 ptb) pi)(setq ag2 (+ (angle pt2 ptb) pi))  )
    
42.             ((< (* pi 1) (angle pt2 ptb) (* pi 1.5))(setq ag2 (- (angle pt2 ptb) pi))  )
    
43.             (t (setq ag2 (angle pt2 ptb) )  )      
    
44.           )
    
45.           (setq pt3 (polar pt2 ag1 (/ d2 2.0))  pt3 (polar pt3 (+ ag2 (* pi 0.5)) 4)      )
    
46.           (setq data4 (subst (cons 10  pt3 ) (assoc 10 data4) data4) )
    
47.           (setq data4 (subst (cons 11  pt3 ) (assoc 11 data4) data4) )
    
48.           (setq data4 (subst (cons 50  ag2 ) (assoc 50 data4) data4) )           
    
49.           (setq data4 (subst (cons 1  (strcat "d1=" (rtos d2 2 3))  ) (assoc 1 data4) data4))
    
50.           (entmod data4)  ;当前段长度         
    
51.          
    
52.         ))
    
53.     );cond   
    
54.    
    
55.   );while
    
56.   (princ "\n绘制结束。")
    
57.   (princ)
    
58. )

(defun c:hddx( / cood d1 d2 data1 data3 data4 en1 en3 en4 gr loop pt1 ptb)<br />   ;动态显示线段的总长度。 by fl202   2018.1.31<br />   (setvar "cmdecho" 0)  <br />   (setq d1 0 pt1 (getpoint "\n 动态显示线段的总长度,请确定起点：")) <br />   (entmake (list '(0 . "line")  (cons 62 2)  (cons 10 pt1) (cons 11 (polar pt1 0 100) ) ) )<br />   (setq en1 (entlast)   data1 (entget en1)  )  <br />   (entmake (list '(0 . "TEXT") (cons 1 (strcat "总长度=" (rtos d1 2 3))) (cons 10 (polar pt1 (* pi 0.5) 10) ) (cons 40 4 )(cons 41 0.75 ) (cons 62 3)))<br />   (setq en3 (entlast)   data3 (entget en3)  ) <br />   (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 11 pt1) (cons 40 4 ) (cons 41 0.75 )(cons 62 3) (cons 71 0) (cons 72 1) (cons 73 2)))<br />   (setq en4 (entlast)   data4 (entget en4)  ) <br />   (setq  loop T)<br />   (while loop<br />     (setq gr (grread T 8))<br />     (setq cood (car gr)  ptb (cadr gr))<br />     (cond<br />       ((= cood 3) ;;; 鼠标左键<br />         (progn<br />           ;(entmake (list '(0 . "TEXT") (cons 1 ftxt1) (cons 10 ptb) (cons 40 h) (cons 62 211) (cons 7 "info")   ))         <br />           (setq pt1 ptb)<br />           (entmake (list '(0 . "line")  (cons 62 2)  (cons 10 pt1) (cons 11 (polar pt1 0 100) ) ) )<br />           (setq en1 (entlast)   data1 (entget en1)  d1 (+ d1 d2) )<br />           (setq data3 (subst (cons 1  (strcat "总长度=" (rtos d1 2 3))  ) (assoc 1 data3) data3))<br />           (entmod data3)<br />           (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 11 pt1) (cons 40 4 )(cons 41 0.75 ) (cons 62 3) (cons 71 0) (cons 72 1) (cons 73 2)  ))<br />           (setq en4 (entlast)   data4 (entget en4)  ) <br />           ;(setq loop nil) <br />         ));;; 鼠标左键<br />       ((= cood 11) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为回车时<br />       ((= cood 25) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为屏幕菜单时 <br />       ((equal gr '(2 32)) (setq loop nil)(entdel en1)(entdel en4))               ;;; 空格键<br />       <br />       ( (= cood 5)  ;;; 鼠标移动<br />         (progn              <br />           ;(setq data1 (subst (cons 10 pt1) (assoc 10 data1) data1))<br />           (setq pt2 (cdr (assoc 10 data1))  data1 (subst (cons 11 ptb) (assoc 11 data1) data1))           <br />           (entmod data1)   <br />           ;(setq d2 (distance pt1 ptb)  midp (list (/ (+ (car pt2) (car ptb) )  2.0)  (/ (+ (cadr pt2) (cadr ptb) )  2.0)   )  ag1 (+ (angle pt2 ptb) (* pi 0.5))  )<br />           (setq d2 (distance pt1 ptb)  ag1 (+ (angle pt2 ptb) 0)  ) <br />           (cond<br />             ((< (* pi 0.5) (angle pt2 ptb) pi)(setq ag2 (+ (angle pt2 ptb) pi))  )<br />             ((< (* pi 1) (angle pt2 ptb) (* pi 1.5))(setq ag2 (- (angle pt2 ptb) pi))  )<br />             (t (setq ag2 (angle pt2 ptb) )  )      <br />           )<br />           (setq pt3 (polar pt2 ag1 (/ d2 2.0))  pt3 (polar pt3 (+ ag2 (* pi 0.5)) 4)      )<br />           (setq data4 (subst (cons 10  pt3 ) (assoc 10 data4) data4) )<br />           (setq data4 (subst (cons 11  pt3 ) (assoc 11 data4) data4) )<br />           (setq data4 (subst (cons 50  ag2 ) (assoc 50 data4) data4) )           <br />           (setq data4 (subst (cons 1  (strcat "d1=" (rtos d2 2 3))  ) (assoc 1 data4) data4))<br />           (entmod data4)  ;当前段长度         <br />           <br />         ))<br />     );cond   <br />     <br />   );while<br />   (princ "\n绘制结束。")<br />   (princ)<br /> )

烟盒迷唇

想到了用reverse倒置获取图元的第二个组码10，接下来该怎么弄呢。

sharetow

文字方向按你自己的要求再调整一下

烟盒迷唇

sharetow 发表于 2020-1-5 10:27
文字方向按你自己的要求再调整一下

谢谢，我已经想通写得出来了！

烟盒迷唇

经过一上午的思考，终于搞定了，也谢谢SHARETOW，虽然还没有看他的代码。

2. ;动态显示线段的总长度。 by fl202   2018.1.31
   
3. ;烟盒迷唇优化，支持多段线绘制 2020年1月5日
   
4. (defun c:hddx( / cood d1 d2 data1 data3 data4 en1 en3 en4 gr loop pt1 ptb)
   
5.   (setvar "cmdecho" 0)  
   
6.   (setq d1 0 pt1 (getpoint "\n 动态显示线段的总长度,只支持多段线，请确定起点："))
   
7.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 62 2) (cons 90 2) (cons 10 pt1) (cons 10 (polar pt1 0 100) ) ) )
   
8.   (setq en1 (entlast)   data1 (entget en1)  )  
   
9.   (entmake (list '(0 . "TEXT") (cons 1 (strcat "总长度=" (rtos d1 2 3))) (cons 10 (polar pt1 (* pi 0.5) 10) ) (cons 40 4 )(cons 41 0.75 ) (cons 62 3)))
   
10.   (setq en3 (entlast)   data3 (entget en3)  )
    
11.   (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 11 pt1) (cons 40 4 ) (cons 41 0.75 )(cons 62 3) (cons 71 0) (cons 72 1) (cons 73 2)))
    
12.   (setq en4 (entlast)   data4 (entget en4)  )
    
13.   (setq  loop T)
    
14.         (while loop
    
15.     (setq gr (grread T 8))
    
16.     (setq cood (car gr)  ptb (cadr gr))
    
17.     (cond
    
18.                         ((= cood 3) ;;; 鼠标左键
    
19.                                 (progn         
    
20.                                         (setq pt1 ptb)
    
21.                                         (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 62 2) (cons 90 2) (cons 10 pt1) (cons 10 (polar pt1 0 100) ) ) )
    
22.                                         (setq en1 (entlast)   data1 (entget en1)  d1 (+ d1 d2) )
    
23.                                         (setq data3 (subst (cons 1  (strcat "总长度=" (rtos d1 2 3))  ) (assoc 1 data3) data3))
    
24.                                         (entmod data3)
    
25.                                         (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 11 pt1) (cons 40 4 )(cons 41 0.75 ) (cons 62 3) (cons 71 0) (cons 72 1) (cons 73 2)  ))
    
26.                                         (setq en4 (entlast)   data4 (entget en4)  )
    
27.                                         ;(setq loop nil)
    
28.                                 ));;; 鼠标左键
    
29.                         ((= cood 11) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为回车时
    
30.                         ((= cood 25) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为屏幕菜单时
    
31.                         ((equal gr '(2 32)) (setq loop nil)(entdel en1)(entdel en4))               ;;; 空格键
    
32.                         
    
33.                         ( (= cood 5)  ;;; 鼠标移动
    
34.                                 (progn              
    
35.                                         (setq pt2 (cdr (assoc 10 data1))  data1 (subst (cons 10 ptb) (assoc 10 (reverse data1)) data1))                 
    
36.                                         (entmod data1)         
    
37.                                         (setq d2 (distance pt1 ptb)  ag1 (+ (angle pt2 ptb) 0)  )
    
38.                                         (cond
    
39.                                                 ((< (* pi 0.5) (angle pt2 ptb) pi)(setq ag2 (+ (angle pt2 ptb) pi))  )
    
40.                                                 ((< (* pi 1) (angle pt2 ptb) (* pi 1.5))(setq ag2 (- (angle pt2 ptb) pi))  )
    
41.                                                 (t (setq ag2 (angle pt2 ptb) )  )      
    
42.                                         )
    
43.                                         (setq pt3 (polar pt2 ag1 (/ d2 2.0))  pt3 (polar pt3 (+ ag2 (* pi 0.5)) 4)      )
    
44.                                         (setq data4 (subst (cons 10  pt3 ) (assoc 10 data4) data4) )
    
45.                                         (setq data4 (subst (cons 11  pt3 ) (assoc 11 data4) data4) )
    
46.                                         (setq data4 (subst (cons 50  ag2 ) (assoc 50 data4) data4) )                 
    
47.                                         (setq data4 (subst (cons 1  (strcat "d1=" (rtos d2 2 3))  ) (assoc 1 data4) data4))
    
48.                                         (entmod data4)                 
    
49.                                        
    
50.                                 ))
    
51.     );cond   
    
52.    
    
53.         );while
    
54.   (princ "\n绘制结束。")
    
55.   (princ)
    
56. )

;动态显示线段的总长度。 by fl202   2018.1.31<br /> ;烟盒迷唇优化，支持多段线绘制 2020年1月5日<br /> (defun c:hddx( / cood d1 d2 data1 data3 data4 en1 en3 en4 gr loop pt1 ptb)<br />   (setvar "cmdecho" 0)  <br />   (setq d1 0 pt1 (getpoint "\n 动态显示线段的总长度,只支持多段线，请确定起点：")) <br />   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 62 2) (cons 90 2) (cons 10 pt1) (cons 10 (polar pt1 0 100) ) ) )<br />   (setq en1 (entlast)   data1 (entget en1)  )  <br />   (entmake (list '(0 . "TEXT") (cons 1 (strcat "总长度=" (rtos d1 2 3))) (cons 10 (polar pt1 (* pi 0.5) 10) ) (cons 40 4 )(cons 41 0.75 ) (cons 62 3)))<br />   (setq en3 (entlast)   data3 (entget en3)  )<br />   (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 11 pt1) (cons 40 4 ) (cons 41 0.75 )(cons 62 3) (cons 71 0) (cons 72 1) (cons 73 2)))<br />   (setq en4 (entlast)   data4 (entget en4)  ) <br />   (setq  loop T)<br />         (while loop<br />     (setq gr (grread T 8))<br />     (setq cood (car gr)  ptb (cadr gr))<br />     (cond<br />                         ((= cood 3) ;;; 鼠标左键<br />                                 (progn         <br />                                         (setq pt1 ptb)<br />                                         (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 62 2) (cons 90 2) (cons 10 pt1) (cons 10 (polar pt1 0 100) ) ) )<br />                                         (setq en1 (entlast)   data1 (entget en1)  d1 (+ d1 d2) )<br />                                         (setq data3 (subst (cons 1  (strcat "总长度=" (rtos d1 2 3))  ) (assoc 1 data3) data3))<br />                                         (entmod data3)<br />                                         (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 11 pt1) (cons 40 4 )(cons 41 0.75 ) (cons 62 3) (cons 71 0) (cons 72 1) (cons 73 2)  ))<br />                                         (setq en4 (entlast)   data4 (entget en4)  ) <br />                                         ;(setq loop nil) <br />                                 ));;; 鼠标左键<br />                         ((= cood 11) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为回车时<br />                         ((= cood 25) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为屏幕菜单时 <br />                         ((equal gr '(2 32)) (setq loop nil)(entdel en1)(entdel en4))               ;;; 空格键<br />                         <br />                         ( (= cood 5)  ;;; 鼠标移动<br />                                 (progn              <br />                                         (setq pt2 (cdr (assoc 10 data1))  data1 (subst (cons 10 ptb) (assoc 10 (reverse data1)) data1))                 <br />                                         (entmod data1)         <br />                                         (setq d2 (distance pt1 ptb)  ag1 (+ (angle pt2 ptb) 0)  ) <br />                                         (cond<br />                                                 ((< (* pi 0.5) (angle pt2 ptb) pi)(setq ag2 (+ (angle pt2 ptb) pi))  )<br />                                                 ((< (* pi 1) (angle pt2 ptb) (* pi 1.5))(setq ag2 (- (angle pt2 ptb) pi))  )<br />                                                 (t (setq ag2 (angle pt2 ptb) )  )      <br />                                         )<br />                                         (setq pt3 (polar pt2 ag1 (/ d2 2.0))  pt3 (polar pt3 (+ ag2 (* pi 0.5)) 4)      )<br />                                         (setq data4 (subst (cons 10  pt3 ) (assoc 10 data4) data4) )<br />                                         (setq data4 (subst (cons 11  pt3 ) (assoc 11 data4) data4) )<br />                                         (setq data4 (subst (cons 50  ag2 ) (assoc 50 data4) data4) )                 <br />                                         (setq data4 (subst (cons 1  (strcat "d1=" (rtos d2 2 3))  ) (assoc 1 data4) data4))<br />                                         (entmod data4)                 <br />                                         <br />                                 ))<br />     );cond   <br />     <br />         );while<br />   (princ "\n绘制结束。")<br />   (princ)<br /> )

烟盒迷唇

用了GRREAD怎么才能使正交模式也有效呢？

ynkmm

老大字体大不如何调呢

p-3-ianlcc

烟盒迷唇 发表于 2020-1-5 12:38
经过一上午的思考，终于搞定了，也谢谢SHARETOW，虽然还没有看他的代码。

你好，请问一下
用这个插件，在动态显示线长的时候，有办法要点下一点时可以“锁点”吗？
感觉好象没办法锁点追踪似的
这样子比较没办法很精确的对准下一点

烟盒迷唇

p-3-ianlcc 发表于 2022-9-27 11:20
你好，请问一下
用这个插件，在动态显示线长的时候，有办法要点下一点时可以“锁点”吗？
感觉好象没办 ...

没办法捕捉的，需要自己研究GRREAD，添加捕捉功能