谁能帮我下载下。LSP.
这个代码有谁用过吗
;;;飞鸟集]心随我动--为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))
页:
1
[2]