[LISP程序]：从别的论坛上下载的一个动态查询信息lisp程序！

似水无痕 · 发表于 2005-12-1 21:24:20

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

从别的论坛上下载的一个动态查询信息lisp程序，感觉挺好，和大家分享！
注：动态查询信息的，加载后输入info命令，当鼠标移动至实体时，会显示其相应信息！

;;功能：动态查询信息
;;文件：info.lsp
;;命令：info
;;作者：YAD
;;时间：2003.8
;;
(defun C:info (/ myerr dxf toang fx add_solid
add_text dis olderr oldos oldfill ss
pd gr pt ent entold
)
(defun myerr (msg)
(setq *error* olderr)
(command "_.undo" "_b")
(princ)
)
(defun dxf (ent i)
(if (= (type ent) 'ename)
(setq ent (entget ent))
)
(cdr (assoc i ent))
)
(defun toang (ang i)
(if (= i 1)
(* ang (/ 180 pi))
(* ang (/ pi 180))
)
)
(defun fx (ang)
(cond
((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
)
)
(defun add_solid (p1 p2 p3 p4)
(entmakex (list (cons 0 "SOLID")
(cons 100 "AcDbEntity")
(cons 62 1)
(cons 100 "AcDbTrace")
(cons 10 p1)
(cons 11 p2)
(cons 12 p3)
(cons 13 p4)
)
)
)
(defun add_text (pt h ang txt style jus)
(entmakex (list (cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 62 2)
(cons 100 "AcDbText")
(if (= jus 0)
(cons 10 pt)
(list 10 0.0 0.0 0.0)
)
(cons 40 h)
(cons 1 txt)
(cons 50 ang)
(cons 7 style)
(cons 72
(cond ((= jus 0) 0)
((= jus 1) 1)
((= jus 2) 1)
((= jus 3) 2)
)
)
(if (= jus 0)
(list 11 0.0 0.0 0.0)
(cons 11 pt)
)
(cons 100 "AcDbText")
(cons 73
(cond ((= jus 0) 0)
((= jus 1) 2)
((= jus 2) 3)
((= jus 3) 2)
)
)
)
)
)
(defun dis (ent / obj laynm name st1 st2 st3 lst h ang n)
(setq obj (vlax-ename->vla-object ent))
(setq laynm (strcat "图层:" (dxf ent 8))
name (dxf ent 0)
)
(cond
((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
)
((= name "3DSOLID")
(setq lst (list "【三维实体】"
laynm
(strcat "格式版本号:" (itoa (dxf ent 70)))
)
)
)
((= name "ACAD_PROXY_ENTITY")
(setq lst (list "【代理】" laynm))
)
((= name "ARC")
(setq lst
(list "【圆弧】"
laynm
(strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "圆心角:"
(rtos (toang (vla-get-TotalAngle obj) 1) 2 1)
"度"
)
(strcat "起始角:"
(rtos (toang (vla-get-StartAngle obj) 1) 2 1)
"度"
)
(strcat "终止角:"
(rtos (toang (vla-get-EndAngle obj) 1) 2 1)
"度"
)
(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 0))
(strcat "面积:"
(rtos (/ (vla-get-Area obj) 1000000) 2 2)
"㎡"
)
)
)
)
((= name "ATTDEF")
(setq
lst (list "【属性定义】"
laynm
(strcat "标签:" (vla-get-TagString obj))
(strcat "提示:" (vla-get-PromptString obj))
(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:"
(rtos (toang (vla-get-Rotation obj) 1) 2 1)
"度"
)
(strcat "文字样式:" (vla-get-StyleName obj))
)
)
)
((= name "ATTRIB")
(setq
lst (list "【属性】"
laynm
(strcat "标签:" (vla-get-TagString obj))
(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:"
(rtos (toang (vla-get-Rotation obj) 1) 2 1)
"度"
)
(strcat "文字样式:" (vla-get-StyleName obj))
)
)
)
((= name "BODY")
(setq lst (list "【体】"
laynm
(strcat "格式版本号:" (itoa (dxf ent 70)))
)
)
)
((= name "CIRCLE")
(setq
lst (list
"【圆】"
laynm
(strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
(strcat "面积:"
(rtos (/ (vla-get-Area obj) 1000000) 2 2)
"㎡"
)
)
)
)
((= name "DIMENSION")
(setq lst
(list
"【尺寸标注】"
laynm
(strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
(strcat "替带文字:"
(if (= (dxf ent 1) "")
"无"
(dxf ent 1)
)
)
)
)
)
((= name "ELLIPSE")
(setq lst
(list
"【椭圆】"
laynm
(strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
(strcat "起始角:"
(rtos (toang (vla-get-StartAngle obj) 1) 2 1)
"度"
)
(strcat "终止角:"
(rtos (toang (vla-get-EndAngle obj) 1) 2 1)
"度"
)
(strcat "面积:"
(rtos (/ (vla-get-Area obj) 1000000) 2 2)
"㎡"
)
)
)
)
((= name "HATCH")
(setq lst
(list
"【图案填充】"
laynm
(strcat "图案名称:" (vla-get-PatternName obj))
(strcat "角度:"
(rtos (toang (vla-get-PatternAngle obj) 1) 2 1)
)
(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
(strcat
"关联:"
(if (= (vla-get-AssociativeHatch obj) :vlax-false)
"关闭"
"打开"
)
)
(strcat
"填充样式:"
(nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略"))
)
)
)
)
((= name "IMAGE")
(setq lst (list "【图像】"
laynm
(strcat "图像大小:"
(rtos (car (dxf ent 13)) 2 0)
"X"
(rtos (cadr (dxf ent 13)) 2 0)
)
)
)
)
((= name "INSERT")
(setq
lst (list "【图块】"
laynm
(strcat "名称:" (dxf ent 2))
(strcat "X比例:" (rtos (dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
(strcat "角度:"
(rtos (toang (vla-get-Rotation obj) 1) 2 1)
"度"
)
)
)
)
((= name "LEADER")
(setq
lst (list
"【引线】"
laynm
(strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:"
(dxf (list (cons 0 "折线") (cons 1 "样条曲线"))
(dxf ent 72)
)
)
)
)
)
((= name "LINE")
(setq
lst (list "【直线】"
laynm
(strcat "长度:" (rtos (vla-get-length obj) 2 0))
(strcat "角度:"
(rtos (toang (vla-get-angle obj) 1) 2 1)
"度"
)
)
)
)
((= name "LWPOLYLINE")
(setq
lst (list "【多段线】"
laynm
(strcat "常量宽度:"
(if (dxf ent 43)
(rtos (vla-get-ConstantWidth obj) 2 0)
"变宽度"
)
)
(strcat "多段线:"
(if (= (vla-get-Closed obj) :vlax-false)
"不闭合"
"闭合"
)
)
(strcat "面积:"
(rtos (/ (vla-get-Area obj) 1000000) 2 2)
"㎡"
)
)
)
)
((= name "MLINE")
(setq lst
(list "【多线】"
laynm
(strcat "多线样式:" (vla-get-StyleName obj))
(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
)
)
)
((= name "MTEXT")
(setq
lst (list "【多行文字】"
laynm
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:"
(rtos (toang (vla-get-Rotation obj) 1) 2 1)
"度"
)
(strcat "样式:" (vla-get-StyleName obj))
)
)
)
((or (= name "OLEFRame") (= name "OLE2FRame"))
(setq lst (list "【OLE边框】"
laynm
(strcat "格式版本号:" (itoa (dxf ent 70)))
)
)
)
((= name "POINT")
(setq lst (list "【点】" laynm))
)
((= name "POLYLINE")
(setq lst (list "【三维多段线】" laynm))
)
((= name "RAY")
(setq lst (list "【射线】" laynm))
)
((= name "REGION")
(setq lst (list "【面域】"
laynm
(strcat "格式版本号:" (itoa (dxf ent 70)))
)
)
)
((= name "SHAPE")
(setq lst
(list
"【形】"
laynm
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
(strcat "角度:"
(rtos (toang (vla-get-Rotation obj) 1) 2 1)
"度"
)
)
)
)
((= name "SOLID")
(setq lst (list "【实体】" laynm))
)
((= name "SPLINE")
(setq
lst (list "【样条曲线】"
laynm
(strcat "多段线:"
(if (= (vla-get-Closed obj) :vlax-false)
"不闭合"
"闭合"
)
)
(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:"
(rtos (/ (vla-get-Area obj) 1000000) 2 2)
"㎡"
)
)
)
)
((= name "TEXT")
(setq lst
(list
"【文字】"
laynm
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
(strcat "角度:"
(rtos (toang (vla-get-Rotation obj) 1) 2 1)
"度"
)
(strcat "样式:" (vla-get-StyleName obj))
(strcat "对齐:"
(nth (vla-get-Alignment obj)
'("Left" "Center"
"Right" "Aligned"
"Middle" "Fit"
"TopLeft" "TopCenter"
"TopRight" "MiddleLeft"
"MiddleCenter" "MiddleRight"
"BottomLeft" "BottomCenter"
"BottomRight"
)
)
)
)
)
)
((= name "TOLERANCE")
(setq lst
(list
"【公差】"
laynm
(strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
)
)
)
((= name "TRACE")
(setq lst (list "【宽线】" laynm))
)
((= name "VERTEX")
(setq lst (list "【顶点】"
laynm
(strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
(strcat "凸度:" (rtos (dxf ent 42) 2 1))
)
)
)
((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
(T
(setq lst (list "【未知对象】" laynm))
)
)
(setq ss (ssadd)
h (/ (getvar "viewsize") 50)
)
(setq ang (fx (angle (getvar "viewctr") pt)))
(setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
(ssadd (add_solid
pt
(polar pt (car ang) (* n h))
(setq pt (polar pt (cadr ang) (+ h (* 1.8 h (length lst)))))
(polar pt (car ang) (* n h))
)
ss
)
(setq pt (polar pt (car ang) (/ (* n h) 2)))
(if (= (caddr ang) 0)
(setq pt (polar pt (/ pi 2) (* 0.4 h)))
(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
)
(setq n -1)
(repeat (length lst)
(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h)))
h
0
(nth (setq n (1+ n)) lst)
"宋体"
1
)
ss
)
)
)
(vl-load-com)
(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error*
*error* myerr
)
(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
(setvar "fillmode" 1)
(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
(command "_.style" "宋体" "宋体" "" "" "" "" "")
)
(setq ss (ssadd))
(while (not pd)
(while (not (progn
(setq gr (grread T 1))
(if (= (car gr) 5)
(setq pt (cadr gr)
ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
)
)
(setq pd T)
)
)
)
)
(if (and (not pd)
(not (equal ent entold))
(not (ssmemb ent ss))
)
(progn
(if entold
(redraw entold 4)
)
(if ss
(command "_.erase" ss "")
)
(redraw ent 3)
(dis ent)
(setq entold ent)
)
)
)
(if entold
(redraw entold 4)
)
(if ss
(command "_.erase" ss "")
)
(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
(setq *error* olderr)
(princ)
)
(prompt "\n***动态查询信息info*** YAD建筑")
(princ)

;;功能：动态查询信息 
;;文件：info.lsp 
;;命令：info 
;;作者：YAD 
;;时间：2003.8 
;; 
 
(defun C:info (/       myerr   dxf     toang   fx      add_solid 
               add_text               dis     olderr  oldos   oldfill ss 
               pd      gr      pt      ent     entold 
              ) 
  (defun myerr (msg) 
    (setq *error* olderr) 
    (command "_.undo" "_b") 
    (princ) 
  ) 
  (defun dxf (ent i) 
    (if        (= (type ent) 'ename) 
      (setq ent (entget ent)) 
    ) 
    (cdr (assoc i ent)) 
  ) 
  (defun toang (ang i) 
    (if        (= i 1) 
      (* ang (/ 180 pi)) 
      (* ang (/ pi 180)) 
    ) 
  ) 
  (defun fx (ang) 
    (cond 
      ((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1)) 
      ((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1)) 
      ((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0)) 
      ((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0)) 
    ) 
  ) 
  (defun add_solid (p1 p2 p3 p4) 
    (entmakex (list (cons 0 "SOLID") 
                    (cons 100 "AcDbEntity") 
                    (cons 62 1) 
                    (cons 100 "AcDbTrace") 
                    (cons 10 p1) 
                    (cons 11 p2) 
                    (cons 12 p3) 
                    (cons 13 p4) 
              ) 
    ) 
  ) 
  (defun add_text (pt h ang txt style jus) 
    (entmakex (list (cons 0 "TEXT") 
                    (cons 100 "AcDbEntity") 
                    (cons 62 2) 
                    (cons 100 "AcDbText") 
                    (if        (= jus 0) 
                      (cons 10 pt) 
                      (list 10 0.0 0.0 0.0) 
                    ) 
                    (cons 40 h) 
                    (cons 1 txt) 
                    (cons 50 ang) 
                    (cons 7 style) 
                    (cons 72 
                          (cond        ((= jus 0) 0) 
                                ((= jus 1) 1) 
                                ((= jus 2) 1) 
                                ((= jus 3) 2) 
                          ) 
                    ) 
                    (if        (= jus 0) 
                      (list 11 0.0 0.0 0.0) 
                      (cons 11 pt) 
                    ) 
                    (cons 100 "AcDbText") 
                    (cons 73 
                          (cond        ((= jus 0) 0) 
                                ((= jus 1) 2) 
                                ((= jus 2) 3) 
                                ((= jus 3) 2) 
                          ) 
                    ) 
              ) 
    ) 
  ) 
  (defun dis (ent / obj laynm name st1 st2 st3 lst h ang n) 
    (setq obj (vlax-ename->vla-object ent)) 
    (setq laynm        (strcat "图层:" (dxf ent 8)) 
          name        (dxf ent 0) 
    ) 
    (cond 
      ((= name "3DFACE") 
       (setq lst (list "【三维面】" laynm)) 
      ) 
      ((= name "3DSOLID") 
       (setq lst (list "【三维实体】" 
                       laynm 
                       (strcat "格式版本号:" (itoa (dxf ent 70))) 
                 ) 
       ) 
      ) 
      ((= name "ACAD_PROXY_ENTITY") 
       (setq lst (list "【代理】" laynm)) 
      ) 
      ((= name "ARC") 
       (setq lst 
              (list "【圆弧】" 
                    laynm 
                    (strcat "半径:" (rtos (vla-get-radius obj) 2 0)) 
                    (strcat "圆心角:" 
                            (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) 
                            "度" 
                    ) 
                    (strcat "起始角:" 
                            (rtos (toang (vla-get-StartAngle obj) 1) 2 1) 
                            "度" 
                    ) 
                    (strcat "终止角:" 
                            (rtos (toang (vla-get-EndAngle obj) 1) 2 1) 
                            "度" 
                    ) 
                    (strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 0)) 
                    (strcat "面积:" 
                            (rtos (/ (vla-get-Area obj) 1000000) 2 2) 
                            "㎡" 
                    ) 
              ) 
       ) 
      ) 
      ((= name "ATTDEF") 
       (setq 
         lst (list "【属性定义】" 
                   laynm 
                   (strcat "标签:" (vla-get-TagString obj)) 
                   (strcat "提示:" (vla-get-PromptString obj)) 
                   (strcat "缺省值:" (vla-get-TextString obj)) 
                   (strcat "高度:" (rtos (vla-get-Height obj) 2 0)) 
                   (strcat "角度:" 
                           (rtos (toang (vla-get-Rotation obj) 1) 2 1) 
                           "度" 
                   ) 
                   (strcat "文字样式:" (vla-get-StyleName obj)) 
             ) 
       ) 
      ) 
      ((= name "ATTRIB") 
       (setq 
         lst (list "【属性】" 
                   laynm 
                   (strcat "标签:" (vla-get-TagString obj)) 
                   (strcat "缺省值:" (vla-get-TextString obj)) 
                   (strcat "高度:" (rtos (vla-get-Height obj) 2 0)) 
                   (strcat "角度:" 
                           (rtos (toang (vla-get-Rotation obj) 1) 2 1) 
                           "度" 
                   ) 
                   (strcat "文字样式:" (vla-get-StyleName obj)) 
             ) 
       ) 
      ) 
      ((= name "BODY") 
       (setq lst (list "【体】" 
                       laynm 
                       (strcat "格式版本号:" (itoa (dxf ent 70))) 
                 ) 
       ) 
      ) 
      ((= name "CIRCLE") 
       (setq 
         lst (list 
               "【圆】" 
               laynm 
               (strcat "半径:" (rtos (vla-get-radius obj) 2 0)) 
               (strcat "周长:" (rtos (vla-get-Circumference obj) 2 0)) 
               (strcat "面积:" 
                       (rtos (/ (vla-get-Area obj) 1000000) 2 2) 
                       "㎡" 
               ) 
             ) 
       ) 
      ) 
      ((= name "DIMENSION") 
       (setq lst 
              (list 
                "【尺寸标注】" 
                laynm 
                (strcat "标注样式:" (vla-get-StyleName obj)) 
                (strcat "文字样式:" (vla-get-TextStyle obj)) 
                (strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1)) 
                (strcat        "替带文字:" 
                        (if (= (dxf ent 1) "") 
                          "无" 
                          (dxf ent 1) 
                        ) 
                ) 
              ) 
       ) 
      ) 
      ((= name "ELLIPSE") 
       (setq lst 
              (list 
                "【椭圆】" 
                laynm 
                (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0)) 
                (strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0)) 
                (strcat        "起始角:" 
                        (rtos (toang (vla-get-StartAngle obj) 1) 2 1) 
                        "度" 
                ) 
                (strcat        "终止角:" 
                        (rtos (toang (vla-get-EndAngle obj) 1) 2 1) 
                        "度" 
                ) 
                (strcat        "面积:" 
                        (rtos (/ (vla-get-Area obj) 1000000) 2 2) 
                        "㎡" 
                ) 
              ) 
       ) 
      ) 
      ((= name "HATCH") 
       (setq lst 
              (list 
                "【图案填充】" 
                laynm 
                (strcat "图案名称:" (vla-get-PatternName obj)) 
                (strcat        "角度:" 
                        (rtos (toang (vla-get-PatternAngle obj) 1) 2 1) 
                ) 
                (strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0)) 
                (strcat 
                  "关联:" 
                  (if (= (vla-get-AssociativeHatch obj) :vlax-false) 
                    "关闭" 
                    "打开" 
                  ) 
                ) 
                (strcat 
                  "填充样式:" 
                  (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")) 
                ) 
              ) 
       ) 
      ) 
      ((= name "IMAGE") 
       (setq lst (list "【图像】" 
                       laynm 
                       (strcat "图像大小:" 
                               (rtos (car (dxf ent 13)) 2 0) 
                               "X" 
                               (rtos (cadr (dxf ent 13)) 2 0) 
                       ) 
                 ) 
       ) 
      ) 
      ((= name "INSERT") 
       (setq 
         lst (list "【图块】" 
                   laynm 
                   (strcat "名称:" (dxf ent 2)) 
                   (strcat "X比例:" (rtos (dxf ent 41) 2 1)) 
                   (strcat "Y比例:" (rtos (dxf ent 42) 2 1)) 
                   (strcat "Z比例:" (rtos (dxf ent 43) 2 1)) 
                   (strcat "角度:" 
                           (rtos (toang (vla-get-Rotation obj) 1) 2 1) 
                           "度" 
                   ) 
             ) 
       ) 
      ) 
      ((= name "LEADER") 
       (setq 
         lst (list 
               "【引线】" 
               laynm 
               (strcat "标注样式:" (vla-get-StyleName obj)) 
               (strcat "引线类型:" 
                       (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) 
                            (dxf ent 72) 
                       ) 
               ) 
             ) 
       ) 
      ) 
      ((= name "LINE") 
       (setq 
         lst (list "【直线】" 
                   laynm 
                   (strcat "长度:" (rtos (vla-get-length obj) 2 0)) 
                   (strcat "角度:" 
                           (rtos (toang (vla-get-angle obj) 1) 2 1) 
                           "度" 
                   ) 
             ) 
       ) 
      ) 
      ((= name "LWPOLYLINE") 
       (setq 
         lst (list "【多段线】" 
                   laynm 
                   (strcat "常量宽度:" 
                           (if (dxf ent 43) 
                             (rtos (vla-get-ConstantWidth obj) 2 0) 
                             "变宽度" 
                           ) 
                   ) 
                   (strcat "多段线:" 
                           (if (= (vla-get-Closed obj) :vlax-false) 
                             "不闭合" 
                             "闭合" 
                           ) 
                   ) 
                   (strcat "面积:" 
                           (rtos (/ (vla-get-Area obj) 1000000) 2 2) 
                           "㎡" 
                   ) 
             ) 
       ) 
      ) 
      ((= name "MLINE") 
       (setq lst 
              (list "【多线】" 
                    laynm 
                    (strcat "多线样式:" (vla-get-StyleName obj)) 
                    (strcat "比例因子:" (rtos (dxf ent 40) 2 1)) 
                    (strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下"))) 
              ) 
       ) 
      ) 
      ((= name "MTEXT") 
       (setq 
         lst (list "【多行文字】" 
                   laynm 
                   (strcat "高度:" (rtos (vla-get-Height obj) 2 0)) 
                   (strcat "角度:" 
                           (rtos (toang (vla-get-Rotation obj) 1) 2 1) 
                           "度" 
                   ) 
                   (strcat "样式:" (vla-get-StyleName obj)) 
             ) 
       ) 
      ) 
      ((or (= name "OLEFRame") (= name "OLE2FRame")) 
       (setq lst (list "【OLE边框】" 
                       laynm 
                       (strcat "格式版本号:" (itoa (dxf ent 70))) 
                 ) 
       ) 
      ) 
      ((= name "POINT") 
       (setq lst (list "【点】" laynm)) 
      ) 
      ((= name "POLYLINE") 
       (setq lst (list "【三维多段线】" laynm)) 
      ) 
      ((= name "RAY") 
       (setq lst (list "【射线】" laynm)) 
      ) 
      ((= name "REGION") 
       (setq lst (list "【面域】" 
                       laynm 
                       (strcat "格式版本号:" (itoa (dxf ent 70))) 
                 ) 
       ) 
      ) 
      ((= name "SHAPE") 
       (setq lst 
              (list 
                "【形】" 
                laynm 
                (strcat "高度:" (rtos (vla-get-Height obj) 2 0)) 
                (strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1)) 
                (strcat        "角度:" 
                        (rtos (toang (vla-get-Rotation obj) 1) 2 1) 
                        "度" 
                ) 
              ) 
       ) 
      ) 
      ((= name "SOLID") 
       (setq lst (list "【实体】" laynm)) 
      ) 
      ((= name "SPLINE") 
       (setq 
         lst (list "【样条曲线】" 
                   laynm 
                   (strcat "多段线:" 
                           (if (= (vla-get-Closed obj) :vlax-false) 
                             "不闭合" 
                             "闭合" 
                           ) 
                   ) 
                   (strcat "阶数:" (rtos (vla-get-Degree obj) 2 0)) 
                   (strcat "面积:" 
                           (rtos (/ (vla-get-Area obj) 1000000) 2 2) 
                           "㎡" 
                   ) 
             ) 
       ) 
      ) 
      ((= name "TEXT") 
       (setq lst 
              (list 
                "【文字】" 
                laynm 
                (strcat "高度:" (rtos (vla-get-Height obj) 2 0)) 
                (strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1)) 
                (strcat        "角度:" 
                        (rtos (toang (vla-get-Rotation obj) 1) 2 1) 
                        "度" 
                ) 
                (strcat "样式:" (vla-get-StyleName obj)) 
                (strcat        "对齐:" 
                        (nth (vla-get-Alignment obj) 
                             '("Left"               "Center" 
                               "Right"               "Aligned" 
                               "Middle"               "Fit" 
                               "TopLeft"       "TopCenter" 
                               "TopRight"      "MiddleLeft" 
                               "MiddleCenter"  "MiddleRight" 
                               "BottomLeft"    "BottomCenter" 
                               "BottomRight" 
                              ) 
                        ) 
                ) 
              ) 
       ) 
      ) 
      ((= name "TOLERANCE") 
       (setq lst 
              (list 
                "【公差】" 
                laynm 
                (strcat "标注样式:" (vla-get-StyleName obj)) 
                (strcat "文字样式:" (vla-get-TextStyle obj)) 
                (strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1)) 
              ) 
       ) 
      ) 
      ((= name "TRACE") 
       (setq lst (list "【宽线】" laynm)) 
      ) 
      ((= name "VERTEX") 
       (setq lst (list "【顶点】" 
                       laynm 
                       (strcat "起始宽度:" (rtos (dxf ent 40) 2 0)) 
                       (strcat "结束宽度:" (rtos (dxf ent 41) 2 0)) 
                       (strcat "凸度:" (rtos (dxf ent 42) 2 1)) 
                 ) 
       ) 
      ) 
      ((= name "XLINE") 
       (setq lst (list "【构造线】" laynm)) 
      ) 
      (T 
       (setq lst (list "【未知对象】" laynm)) 
      ) 
    ) 
    (setq ss (ssadd) 
          h  (/ (getvar "viewsize") 50) 
    ) 
    (setq ang (fx (angle (getvar "viewctr") pt))) 
    (setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0)))) 
    (ssadd (add_solid 
             pt 
             (polar pt (car ang) (* n h)) 
             (setq pt (polar pt (cadr ang) (+ h (* 1.8 h (length lst))))) 
             (polar pt (car ang) (* n h)) 
           ) 
           ss 
    ) 
    (setq pt (polar pt (car ang) (/ (* n h) 2))) 
    (if        (= (caddr ang) 0) 
      (setq pt (polar pt (/ pi 2) (* 0.4 h))) 
      (setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst))))) 
    ) 
    (setq n -1) 
    (repeat (length lst) 
      (ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) 
                       h 
                       0 
                       (nth (setq n (1+ n)) lst) 
                       "宋体" 
                       1 
             ) 
             ss 
      ) 
    ) 
  ) 
  (vl-load-com) 
  (command "_.undo" "_m") 
  (prompt "\n***移动鼠标掠过对象查看信息！***") 
  (setq        olderr        *error* 
        *error*        myerr 
  ) 
  (setq oldos (getvar "osmode")) 
  (setq oldfill (getvar "fillmode")) 
  (setvar "osmode" 0) 
  (setvar "fillmode" 1) 
  (setvar "cmdecho" 0) 
  (if (not (tblsearch "style" "宋体")) 
    (command "_.style" "宋体" "宋体" "" "" "" "" "") 
  ) 
 
  (setq ss (ssadd)) 
  (while (not pd) 
    (while (not        (progn 
                  (setq gr (grread T 1)) 
                  (if (= (car gr) 5) 
                    (setq pt  (cadr gr) 
                          ent (nentselp pt) 
                          ent (if (and ent (= (type (last (last ent))) 'ename)) 
                                (last (last ent)) 
                                (car ent) 
                              ) 
                    ) 
                    (setq pd T) 
                  ) 
                ) 
           ) 
    ) 
    (if        (and (not pd) 
             (not (equal ent entold)) 
             (not (ssmemb ent ss)) 
        ) 
      (progn 
        (if entold 
          (redraw entold 4) 
        ) 
        (if ss 
          (command "_.erase" ss "") 
        ) 
        (redraw ent 3) 
        (dis ent) 
        (setq entold ent) 
      ) 
    ) 
  ) 
  (if entold 
    (redraw entold 4) 
  ) 
  (if ss 
    (command "_.erase" ss "") 
  ) 
  (setvar "osmode" oldos) 
  (setvar "fillmode" oldfill) 
  (setq *error* olderr) 
  (princ) 
) 
(prompt "\n***动态查询信息info***   YAD建筑") 
(princ)

aichong · 发表于 2005-12-1 21:32:27

适用于什么版本？

似水无痕 · 发表于 2005-12-1 22:02:01

最初由 aichong 发布
[B]适用于什么版本？ [/B]

我目前用的是2005，其它版本没有试过！

xjlmlxbq · 发表于 2005-12-6 18:53:18

要是象pscope不用输入任何命令，当鼠标移动到一个实体上时，能实时显示实体特性，就更爽了。

qjcpj · 发表于 2005-12-11 19:20:11

不错！谢谢共享。

wwwdh · 发表于 2005-12-13 10:28:27

哪个论坛里的东东，多贴几个出来吧。。。

lgwlgw · 发表于 2006-1-14 23:05:41

好用,好东西,谢谢共享!

az98hxq · 发表于 2006-1-22 18:55:04

可以比较适用的东东

greatchang · 发表于 2006-1-22 20:00:35

显示多线段宽度不准确

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

[LISP程序]：从别的论坛上下载的一个动态查询信息lisp程序！

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子