佩服，真是厉害！
我会顶到你肾疼
华丽的命令啊
本帖最后由 Gu_xl 于 2013-5-20 22:54 编辑
动态信息查询,由一个经典的yad动态信息查询函数改编而来!
;;;飞鸟集]心随我动--为LISP定制的动态输入，动态拖拉和动态信息函数之应用---动态信息查询
;;;由一个经典的yad动态信息查询函数改编而来！改编： Gu_xl 2011.11.19
(defun InfoCallBak (PT /TOANG DIS ENT)
(defun toang(ang i)
(if (= i 1)
(* ang (/ 180 pi))
(* ang (/ pi 180))
)
)
(defun gxl-dxf (ent i)
(cdr (assoc i (entget ent)))
)
(defun dis (ENT / MJBL OBJ LAYNM NAME LST)
(if (= mjdw 1000) (setq mjbl 1000000) (setq mjbl 1))
(setq obj (vlax-ename->vla-object ent))
(setq laynm (strcat "图层:" (gxl-dxf ent 8)) name (gxl-dxf ent 0))
(cond
((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
)
((= name "3DSOLID")
(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (gxl-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) mjbl) 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 (gxl-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) mjbl) 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 (= (gxl-dxf ent 1) "") "无" (gxl-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) mjbl) 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 (gxl-dxf ent 13)) 2 0) "X" (rtos (cadr (gxl-dxf ent 13)) 2 0))))
)
((= name "INSERT")
(setq lst (list "【图块】" laynm (strcat "名称:" (gxl-dxf ent 2))
(strcat "X比例:" (rtos (gxl-dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (gxl-dxf ent 42) 2 1))
(strcat "Z比例:" (rtos (gxl-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 "引线类型:" (gxl-dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (gxl-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 (gxl-dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "面积:" (rtos (/ (vla-get-Area obj) mjbl) 2 2) "㎡")
))
)
((= name "MLINE")
(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
(strcat "比例因子:" (rtos (gxl-dxf ent 40) 2 1))
(strcat "对齐:" (nth (gxl-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 (gxl-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 (gxl-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) mjbl) 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 (gxl-dxf ent 40) 2 0))
(strcat "结束宽度:" (rtos (gxl-dxf ent 41) 2 0))
(strcat "凸度:" (rtos (gxl-dxf ent 42) 2 1))
))
)
((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
(T
(setq lst (list "【未知对象】" laynm))
)
)
(apply 'strcat (mapcar '(lambda (x)(strcat x "\n")) lst))
)
(if (setq ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
)
)
(dis ent)
)
)
(defun c:DynInfo(/ loaded openview closeview)
(defun openview(/ arxs)
(VL-ACAD-DEFUN 'InfoCallBak)
(if (null mjdw)
(progn
(INITget 7 "Yes No")
(setq Mjdw (getKword "\n以毫米为单位?[<Yes/No>]<No>:"))
(if (= mjdw "Yes")
(setq mjdw 1000)
(setq mjdw 999)
)
)
)
(HFB_PointMonitor)
(HFB_PointMonitor "InfoCallBak")
(princ "\n动态信息查看打开！")
(setq *dynViewEnt* t)
)
(defun closeview()
(HFB_PointMonitor)
(princ "\n动态信息查看关闭！")
(setq *dynViewEnt* nil)
)
(cond ((= 16 (atoi (getvar 'acadver)))
(if (not (member "dynarxfor2004-2006.arx" (arx)))
(if (setq fn (findfile "dynarxfor2004-2006.arx"))
(setq loaded (arxload fn "1"))
(setq loaded "2")
)
(setq loaded "3") ;_ 已加载
)
)
((= 17 (atoi (getvar 'acadver)))
(if (not (member "dynarxfor2007-2009.arx" (arx)))
(if (setq fn (findfile "dynarxfor2007-2009.arx"))
(setq loaded (arxload fn "1"))
(setq loaded "2")
)
(setq loaded "3")
)
)
((= 18 (atoi (getvar 'acadver)))
(if (= "x86" (getenv "PROCESSOR_ARCHITECTURE"))
(if (not (member "dynarxfor2010-2012x32.arx" (arx)))
(if (setq fn (findfile "dynarxfor2010-2012x32.arx"))
(setq loaded (arxload fn "1"))
(setq loaded "2")
)
(setq loaded "3")
)
(if (not (member "dynarxfor2010-2012x64.arx" (arx)))
(if (setq fn (findfile "dynarxfor2010-2012x64.arx"))
(setq loaded
(arxload (findfile "dynarxfor2010-2012x64.arx")
"1"))
(setq loaded "2")
)
(setq loaded "3")
)
)
)
(t (setq loaded "2"))
)
(if (not (or (= "1" loaded) (= "2" loaded)))
(if *dynViewEnt*
(closeview)
(openview)
)
)
(princ)
)
终于找到了我最想要的程序了，热泪盈眶啊
楼主的函数能够捕获键盘输入信息么 比如是按了那个字母 这样就可以定义cad的热键了
还是输入关键字正宗些！
“热键”啥的没必要吧~！那只是grread没办法才“热键”
还是输入关键字正宗些！
“热键”啥的没必要吧~！那只是grread没办法才“热键”
期待LZ五十楼的惊喜
刚好五十楼了，奖励来了