关于动态信息显示有必要再深入研究
本帖最后由 尘缘一生 于 2023-6-9 06:31 编辑如题：
今用一天时间，重写这部分代码，加入自己对这一问题的考虑，并求得它的速度提高。
我一直认为，代码本身并不重要，重要的是思路，想法和原理。因此，拿来就用的原则，不赞同，因为，这样对你并没有好处，不会进步的。
对于
[*]vla-get-TextHeight 这个问题，严重怀疑它的正确性！为此，代码全部抛弃它的使用，
[*]改为整合三领函数库，并对标注问题，求得它的实际图距，这样我们再取得标注信息时候，能人为的
[*]看出它的图纸比例是什么。
[*]对于钢筋问题，能显示面积出来
[*]并整合了右键菜单技术，能想写出来就写出来
[*]对于有业内人士提出的，需要显示图层，颜色，线型问题，加进去
[*]效果测试可以安装三领检验它的正确与否
链接：https://pan.baidu.com/s/1l5C1jjXZpLwsRjwjbIxh_w
提取码：ztfv
sl:yjcaidan ,函数，是关键函数 本帖最后由 尘缘一生 于 2023-6-9 06:25 编辑
不可bai2000 发表于 2023-6-8 22:15
sl:yjcaidan ,函数，是关键函数
记得这是本坛，wowan1314大师源码，可以搜索去下载下。
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=101509&highlight=%D3%D2%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)
[*])
页:
[1]