标高符号v2源码解析与测试(左击缩小grread，生成对象entmakex应用，支持UCS）
本帖最后由 林霄云 于 2014-1-21 12:16 编辑标高符号v2——调整逻辑，支持UCS
原版本 标高符号源码解析与测试(左击缩小grread，生成对象entmakex应用）
http://bbs.mjtd.com/forum.php?mo ... 087&fromuid=7303580
子程序elev-symbol(str pt)
;函数elev-symbol(str pt),参数str:string pt:point（UCS下），返回值，生成对象的选择集
;Desiged by 林霄云 2014年1月20日进行如下修改，以增加UCS支持，感谢G版照顾与其坐标系统解读。(setq ucszdir (trans '(0 0 1) 1 0 T ));生成OCS法向量
(setq ang (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 ucszdir)));生成UCS在OCS的角度，不通过组码，通过旋转实现
(setq pte (trans (trans pt 1 0) 0 ucszdir ));将插入点从UCS转WCS后转OCS对硬编码的点，转换到OCS坐标系下(setq pt-text10 (mapcar '+ pte (trans '(350 325 0) 0 ucszdir)))
(setq pt-text11 (mapcar '+ pte (trans '(460 325 0) 0 ucszdir )))
(setq pt-pl1 (mapcar '+ pte (trans '(225 225 0) 0 ucszdir )))
(setq pt-pl2 (mapcar '+ pte (trans '(-225 225 0) 0 ucszdir )))
(setq pt-pl3 (mapcar '+ pte (trans '(1145 225 0) 0 ucszdir )))
(setq pt-l1 (mapcar '+ pte (trans '(-275 0 0) 0 ucszdir )))
(setq pt-l2 (mapcar '+ pte (trans '(275 0 0) 0 ucszdir )))将entmakex里的组码210修改为(cons 210 ucszdir)加入旋转，通过command实现，pt为UCS下的点(command "rotate" ss "" pt (angtos ang 0))主函数C:ES();Elev-Symbol 标高符号逻辑修改，主要针对grread函数(prompt "\n缩小一半左击或S，放大一倍A，逆时针旋转R，顺时针旋转E，右击确认继续")
(while (and (setq ptr (grread t 15 2))
(not (and (= 2 (car ptr)); 键盘事件
(or (= 13 (cadr ptr)) (= 32 (cadr ptr))) ;_Enter Space
))
(not (or (= (car ptr) 11) (= (car ptr) 25)));_Mouse Right button
)
; (redraw)
(cond ((= (car ptr) 3);_Mouse Left button
(command "scale" ss "" pt 0.5) ;左键进行0.5倍缩小，测试ss选择集方式可行。
))
(cond ((= (car ptr) 2);键盘事件
(if (or (= (ascii "S") (cadr ptr)) (= (ascii "s") (cadr ptr))) (command "scale" ss "" pt 0.5))
(if (or (= (ascii "A") (cadr ptr)) (= (ascii "a") (cadr ptr))) (command "scale" ss "" pt 2))
(if (or (= (ascii "R") (cadr ptr)) (= (ascii "r") (cadr ptr))) (command "rotate" ss "" pt 90))
(if (or (= (ascii "E") (cadr ptr)) (= (ascii "e") (cadr ptr))) (command "rotate" ss "" pt -90))
))
);while值得注意的是，command Rotate 时，可以接收string类型作为角度值。
结论：
较强的逻辑性，更加丰富的grread应用。
感觉好高深啊，像楼主学习 ;;-----------------------=={ Elevation Marker }==-----------------------;;
;; ;;
;;This program continuously prompts the user to specify a point and ;;
;;constructs an elevation marker composed of a variable width ;;
;;polyline & single-line text object at the specified point, with ;;
;;the text content displaying the UCS Y-coordinate of the point. ;;
;; ;;
;;----------------------------------------------------------------------;;
;;Author:Lee Mac, Copyright © 2013-www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
(defun c:em ( / *error* ang hgt len ocs pt1 pt2 pt3 pt4 str )
(defun *error* ( msg )
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(setq hgt (getvar 'textsize)
ocs (trans '(0.0 0.0 1.0) 1 0 t)
ang (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
)
(terpri)
(while (setq pt1 (getpoint "\rSpecify point <exit>: "))
(setq str (rtos (cadr pt1))
len (strlen str)
pt2 (list (carpt1) (+ (cadr pt1) (* hgt 0.5 (sqrt 3))))
pt3 (list (- (car pt1) (* hgt len)) (cadr pt2))
pt4 (list (- (car pt2) (* hgt 0.5 len)) (+ (cadr pt2) hgt))
)
(foreach sym '(pt1 pt2 pt3 pt4)
(set sym (trans (eval sym) 1 ocs))
)
(entmake
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(090 . 3)
'(070 . 0)
(cons 038 (caddr pt1))
(cons 010 pt1)
'(040 . 0.0)
(cons 041 hgt)
(cons 010 pt2)
(cons 040 (* hgt 0.05))
(cons 041 (* hgt 0.05))
(cons 010 pt3)
(cons 210 ocs)
)
)
(entmake
(list
'(000 . "TEXT")
(cons 007 (getvar 'textstyle))
(cons 001 str)
(cons 050 ang)
(cons 040 hgt)
(cons 010 pt4)
(cons 011 pt4)
'(072 . 1)
'(073 . 2)
(cons 210 ocs)
)
)
)
(princ)
)
sachindkini 发表于 2014-1-21 13:21
嗯，lee版本将各特征点与字高发生关系，是一种方式。 很实用的工具，谢谢分享 为什么不能自动算取标高 为什么我这里即使输入文字也只生成标高符号，没有标高的文字？ adc 发表于 2014-1-24 13:17 static/image/common/back.gif
为什么我这里即使输入文字也只生成标高符号，没有标高的文字？
因为你没有字体。你得修改生成G_text字体样式，对应的字体文字。这是主要用于结构，不需要自动计算。
回复用以学习 不错，要是能加入动态标高就好了！跟天正一样。
页:
[1]
2