动态显示长度代码修改

sunny_8848

在论坛找到一个画线代码，请求帮忙修改下：1.点可以(捕捉)选择也可以输入2.只需要显示标注就行，动态显示可以取消3.设置都随当前设置，比如标注，文字随当前样式，层随当前设置等，实际功能就是画线和标注功能二合一。
http://bbs.mjtd.com/thread-176541-2-1.html

(defun c:g15( / cood d1 d2 data1 data3 data4 en1 en3 en4 gr loop pt1 ptb)
;动态显示线段的总长度。 by fl202   2018.1.31
  (setvar "cmdecho" 0)  
  (setq d1 0 pt1 (getpoint "\n 动态显示线段的总长度,请确定原点："))
  (entmake (list '(0 . "line")  (cons 62 2)  (cons 10 pt1) (cons 11 (polar pt1 0 100) ) ) )
  (setq en1 (entlast)   data1 (entget en1)  )  
  (entmake (list '(0 . "TEXT") (cons 1 (strcat "Dsum=" (rtos d1 2 3))) (cons 10 (polar pt1 (* pi 0.5) 60) ) (cons 40 100 )(cons 41 0.85 ) (cons 62 3)  ))
  (setq en3 (entlast)   data3 (entget en3)  )
  (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 40 100 ) (cons 41 0.85 )(cons 62 3)  ))
  (setq en4 (entlast)   data4 (entget en4)  )
  (setq  loop T)
(while loop
    (setq gr (grread T 8))
    (setq cood (car gr)  ptb (cadr gr))
    (cond
       ((= cood 3) ;;; 鼠标左键
          (progn
                 ;(entmake (list '(0 . "TEXT") (cons 1 ftxt1) (cons 10 ptb) (cons 40 h) (cons 62 211) (cons 7 "info")   ))         
                 (setq pt1 ptb)
                 (entmake (list '(0 . "line")  (cons 62 2)  (cons 10 pt1) (cons 11 (polar pt1 0 100) ) ) )
                 (setq en1 (entlast)   data1 (entget en1)  d1 (+ d1 d2) )
                 (setq data3 (subst (cons 1  (strcat "Dsum=" (rtos d1 2 3))  ) (assoc 1 data3) data3))
                     (entmod data3)
                     (entmake (list '(0 . "TEXT") (cons 1 (strcat "d1=" (rtos d1 2 3))) (cons 10 pt1) (cons 40 100 )(cons 41 0.85 ) (cons 62 3)  ))
                 (setq en4 (entlast)   data4 (entget en4)  )
                 ;(setq loop nil)
       ));;; 鼠标左键
       ((= cood 11) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为回车时
       ((= cood 25) (setq loop nil)(entdel en1)(entdel en4)  );;; 鼠标右键，右键设置为屏幕菜单时
       ((equal gr '(2 32)) (setq loop nil)(entdel en1)(entdel en4))               ;;; 空格键

       ( (= cood 5)  ;;; 鼠标移动
          (progn              
                 ;(setq data1 (subst (cons 10 pt1) (assoc 10 data1) data1))
                 (setq pt2 (cdr (assoc 10 data1))  data1 (subst (cons 11 ptb) (assoc 11 data1) data1))                 
                 (entmod data1)         
                 ;(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))  )
                 (setq d2 (distance pt1 ptb)  ag1 (+ (angle pt2 ptb) 0)  )
                 (cond
                 ((< (* pi 0.5) (angle pt2 ptb) pi)(setq ag2 (+ (angle pt2 ptb) pi))  )
                 ((< (* pi 1) (angle pt2 ptb) (* pi 1.5))(setq ag2 (- (angle pt2 ptb) pi))  )
                 (t (setq ag2 (angle pt2 ptb) )  )      
                 )
                 (setq pt3 (polar pt2 ag1 (/ d2 2.0))  pt3 (polar pt3 (+ ag2 (* pi 0.5)) 30)      )
                 (setq data4 (subst (cons 10  pt3 ) (assoc 10 data4) data4) )                 
                 (setq data4 (subst (cons 50  ag2 ) (assoc 50 data4) data4) )                 
                 (setq data4 (subst (cons 1  (strcat "d1=" (rtos d2 2 3))  ) (assoc 1 data4) data4))
                 (entmod data4)        ;当前段长度         

         ))
    );cond   

);while
  (princ "\n    over 。")
  (princ)
)

start4444

凑合用用减轻工作量，标注间距什么的自己调下
(defun c:tt5 (/ p1 p2)
(command "undo" "be")       
(setq p1 (getpoint "\n起点:"))
(while (setq p2 (getpoint p1 "\n下一点:"))
             (command "line" "non" p1 "non" p2 "" "DIMALIGNED" "non" p1 "non"  p2 "non" (polar p1 (+ (angle p1 p2) (* 0.5 pi)) 5))
             (setq p1 p2)
)       
(command "undo" "e")       
(princ)
)

sunny_8848

自己顶一次，请大家帮忙

start4444

动态捕捉比较麻烦，直接画根线自动标注头尾多好

sunny_8848

start4444 发表于 2021-2-1 19:48
动态捕捉比较麻烦，直接画根线自动标注头尾多好

我主要是画1:1布置图用的，点一般都是靠输入坐标，这样代码难度低些了，我也可以省略标注的麻烦了，老大帮忙弄下？

sunny_8848

start4444 发表于 2021-2-2 01:10
凑合用用减轻工作量，标注间距什么的自己调下
(defun c:tt5 (/ p1 p2)
(command "undo" "be")       

谢谢帮忙。不知道能否麻烦您修改下，这样就完美了：1.标注间距可以在代码中设置2.可以设置是否要标注，比如直线画一个矩形，标注两条边就行了

start4444

sunny_8848 发表于 2021-2-2 09:55
谢谢帮忙。不知道能否麻烦您修改下，这样就完美了：1.标注间距可以在代码中设置2.可以设置是否要标注，比 ...

你先描述一下操作过程吧，现在就一个标注一根线，你说不要标注那就是画直线了····而且你设定那么多选项这个操作能快的了吗

sunny_8848

不知道论坛怎么上传不了附件图片。比如画一块折弯的铜排，我只需要标注一边的 尺寸和厚度，另外一边的尺寸不需要了，一个矩形，标注长和宽就行了。另外，直线或矩形标注怎么在内侧，尝试更改标注样式还是一样的
我是用vb输入点坐标的，可以用代码设置选项，图纸就不需要手工去修改了

sunny_8848

设置一下选项，画线并标注，VB代码再设置下选项画线不标注，这样就不需要修改了