标高符号v2源码解析与测试(左击缩小grread，生成对象entmakex应用，支持UCS）

林霄云 · 发表于 2014-1-21 12:14:30

本帖最后由林霄云于 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

(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应用。

海盗曹 · 发表于 2014-1-21 12:32:24

感觉好高深啊，像楼主学习

sachindkini · 发表于 2014-1-21 13:21:19

;;-----------------------=={ 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 (car pt1) (+ (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)
)

;;-----------------------=={ 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 &#169; 2013  -  <a href="http://www.lee-mac.com" target="_blank">www.lee-mac.com</a>              ;; 
;;----------------------------------------------------------------------;; 
 
(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 (car  pt1) (+ (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) 
)

林霄云 · 发表于 2014-1-21 16:05:37

sachindkini 发表于 2014-1-21 13:21

嗯，lee版本将各特征点与字高发生关系，是一种方式。

phoevana · 发表于 2014-1-24 08:09:03

很实用的工具，谢谢分享

phoevana · 发表于 2014-1-24 08:37:40

为什么不能自动算取标高

adc · 发表于 2014-1-24 13:17:37

为什么我这里即使输入文字也只生成标高符号，没有标高的文字？

林霄云 · 发表于 2014-1-24 16:51:54

adc 发表于 2014-1-24 13:17
为什么我这里即使输入文字也只生成标高符号，没有标高的文字？

因为你没有字体。你得修改生成G_text字体样式，对应的字体文字。这是主要用于结构，不需要自动计算。

ckss · 发表于 2014-1-24 23:52:12

回复用以学习

xiaobaixiaobu · 发表于 2014-2-12 14:23:52

不错，要是能加入动态标高就好了！跟天正一样。

账号		自动登录	找回密码
密码			注册

[讨论] 标高符号v2源码解析与测试(左击缩小grread，生成对象entmakex应用，支持UCS）

本帖子中包含更多资源

评分

相关帖子