明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 657|回复: 1

[提问] 求修改入如下标注程序,程序来源于论坛,作者fl202

[复制链接]
发表于 2018-7-22 15:10:47 | 显示全部楼层 |阅读模式
如下程序,画线标注长度,动态写在直线上,其中前缀默认的标注为d1=,能否改为从图纸提取前缀,比如图纸的文字是“你好”则变成 你好=,默认的长度按单位mm,能否改为长度按单位m,保留三位小数,如果小数后是0,把0忽略


(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)
)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
"觉得好,就打赏"
还没有人打赏,支持一下
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-5-19 09:21 , Processed in 0.177716 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表