关于动态信息显示有必要再深入研究

尘缘一生

如题：

今用一天时间，重写这部分代码，加入自己对这一问题的考虑，并求得它的速度提高。
我一直认为，代码本身并不重要，重要的是思路，想法和原理。因此，拿来就用的原则，不赞同，因为，这样对你并没有好处，不会进步的。

对于

• vla-get-TextHeight 这个问题，严重怀疑它的正确性！为此，代码全部抛弃它的使用，
• 改为整合三领函数库，并对标注问题，求得它的实际图距，这样我们再取得标注信息时候，能人为的
• 看出它的图纸比例是什么。
• 对于钢筋问题，能显示面积出来
• 并整合了右键菜单技术，能想写出来就写出来
• 对于有业内人士提出的，需要显示图层，颜色，线型问题，加进去
• 效果测试可以安装三领检验它的正确与否
  

链接：https://pan.baidu.com/s/1l5C1jjXZpLwsRjwjbIxh_w
提取码：ztfv

bai2000

sl:yjcaidan ,函数，是关键函数

尘缘一生

不可bai2000 发表于 2023-6-8 22:15
sl:yjcaidan ,函数，是关键函数

记得这是本坛，wowan1314大师源码，可以搜索去下载下。
http://bbs.mjtd.com/forum.php?mo ... 2%BC%FC%B2%CB%B5%A5
三领集成进去的，已经血肉整合，不可直接用了

• ;; 右键菜单函数--先关闭捕捉========(一级)========
• ;; pt 表格产生点，len0 格子大小。tuxian 为要作底的文字内容.
• ;; wzlst 为要写的文字表. len1 横向长度,共计5个参数 tuxian 可为nil，其他必须有值.
• ;; 表格横向固定2格，竖向多少格由文字表决定. 横向长度自定. 文字样式随当前
• ;; 返回值：表(1 "dn15").第一个表示选择的第几格，第二项为文字内容.
• (defun sl:yjcaidan (pt len0 len1 wzlst tuxian / x y pmpt x1 x0 y0 y1 gplst hangshu i n been p1 p2 p3 p4 plst p1lst wznamlst wzgz wpt wzhigh
•                      wz oldhi beend loop code newwz e_lst *error* num ln len2 gpt high wz1 p0 k
•                    )
•   ;;作移动--------
•   (defun do_move (p0)
•     (setq i -1)
•     (while (and i (< i (length gplst)))
•       (setq i (1+ i) wzgz (nth i gplst))
•       (if (and
•             (< (car (car wzgz)) (car p0) (car (cadr wzgz)))
•             (< (cadr (car wzgz)) (cadr p0) (cadr (cadr wzgz)))
•             (setq wz (nth i wznamlst))
•           )
•         (progn
•           (setq high (* 1.2 (dxf1 (cadr wz) 40)))
•           (setq wz1 (car wz) wz (cadr wz))
•           (if (/= wz1 oldwz1)
•             (progn
•               (redraw)
•               (entmod (emod (emod wz 62 6) 40 high))
•               (entmod (emod (emod oldwz 62 3) 40 oldhi))
•               (setq oldwz1 wz1 oldwz wz)
•               (grvecs (list -6 (car wzgz) (caddr wzgz) -6 (caddr wzgz) (cadr wzgz) -6 (cadr wzgz) (last wzgz) -6 (last wzgz) (car wzgz)))
•             )
•           )
•           (setq num (1+ i) i nil)
•         )
•       )
•     )
•     (if i
•       (progn
•         (entmod (emod (emod oldwz 62 3) 40 oldhi))
•         (setq oldwz1 nil oldwz nil)
•         (redraw)
•       )
•     )
•     num
•   )
•   ;;--------
•   (setq e_lst (sysvar '("autosnap" "osmode" "qaflags")))
•   (setvar "osmode" 0) ;关闭
•   (defun *error* (msg)
•     (if beend (sl:-erase beend))
•     (redraw)
•     (mapcar 'eval e_lst) ;;恢复系统变量
•     (if (not (member msg '(nil "Function canceled" ";error:quit / exit abort")))
•       (princ (strcat "\n exit:" "--->"))
•     )
•   )
•   ;----------------------
•   (setq x (car pt) y (cadr pt) len2 (+ len1 len1) ln (atoi (rtos (* (length wzlst) 0.5) 2 0)))
•   (setq
•     pmpt (sl_pm2pt)
•     x1 (+ x len2)
•     x0 (car (cadr pmpt))
•     y0 (cadr (car pmpt))
•     y1 (- y (* ln 0.5 len0))
•   )
•   (and (> x1 x0) (setq x (- x (- x1 x0))))    ;当超过屏幕右边线
•   (and (< y1 y0) (setq y (+ y (- y0 y1))))    ;当超过屏幕底边线
•   ;计算起始点及wipeout作底
•   (setq gplst '())
•   (setq
•     hangshu (1+ ln)
•     i 1
•     been (entlast)
•     y1 (- y (* ln 0.5 len0))
•   )
•   (setq
•     p1 (list x y 0)
•     p2 (list (+ x len2) y 0)
•     p3 (list x y1 0)
•     p4 (list (+ x len2) y1 0)
•   )
•   (sl:solid p1 p2 p3 p4 18) ;;底框
•   (while (<= i hangshu)
•     (setq p1 (list x y 0)
•       p2 (list (+ x len2) y 0)
•       p3 (list (+ x len1) y 0)
•       y (- y (* len0 0.5))
•     )
•     (slch:line p1 p2 nil 7 nil)
•     (if (> i 1)
•       (setq gplst (cons (list p3 (cadr plst) p2 (last plst)) (cons (list p1 (last plst) p3 (car plst)) gplst)))
•     )
•     (setq plst (list p1 p2 p3))
•     (if (= i 1)
•       (setq p1lst plst)
•     )
•     (setq i (1+ i))
•   )  ; 画横线结束
•   (setq gplst (reverse gplst))         ; 画竖线
•   (slch:line (car p1lst) (car plst) nil 7 nil)
•   (slch:line (cadr p1lst) (cadr plst) nil 7 nil)
•   (slch:line (caddr p1lst) (caddr plst) nil 7 nil)
•   (setq i -1 n -1 wznamlst '())
•   (repeat (length wzlst)
•     (setq
•       wz (nth (setq n (1+ n)) wzlst)
•       wzgz (nth (setq i (1+ i)) gplst)
•       wpt (sl:mid (car wzgz) (cadr wzgz))
•       wzhigh (* 0.23 len0)
•     )
•     (and
•       (= wz tuxian)
•       (sl:solid (car wzgz) (caddr wzgz) (last wzgz) (cadr wzgz) 7) ;原文字对应的底框soli
•     )
•     (slmkwz wz wpt (/ wzhigh SLBL) nil nil "PUB_TEXT" nil 2 "m")
•     (setq wznamlst (cons (list wz (entlast)) wznamlst))
•   )
•   (setq wznamlst (reverse wznamlst))
•   (setq wz (car wznamlst)
•     oldhi (dxf1 (cadr wz) 40)
•   )
•   (setq beend (last_ent been))   ; 所有产生的物体的选择集
•   (setq loop t)
•   (while loop
•     (setq code (grread nil 13 2) k (car code) p0 (cadr code))
•     (cond
•       ((not (member k '(3 11 25))) ;当左键，右键没有响应时
•         (setq num (do_move p0))
•       )
•       ((member k '(11 25)) ;右键 退出
•         (setq loop nil)
•       )
•       ((= k 3)  ;;左键
•         (setq num (do_move p0))
•         (and oldwz1 (setq loop nil))
•       )
•     )
•   )
•   (if oldwz1 (setq newwz oldwz1))
•   (sl:-erase beend)
•   (redraw)
•   (mapcar 'eval e_lst)
•   (setq *error* nil)
•   (sl-cishu)
•   (list num newwz)
• )