@lisp Editor ui:dynquery

用法

建议

(defun ui:dynquery (func / *error* dxf fx add_background add_box add_text display olderr oldos oldfill ss pd gr pt ent entold)
  "动态查询。显示 func 返回的文本列表。func 是对图标所在图元进行的运算结果。形式如 '(lambda (x)\n    (list (entity:getdxf x 0)))\n  "
  "nil,执行过程动态显示用户定义的内容"
  "(ui:dynquery '(lambda (x)\n      (list (entity:getdxf x '(0 8)))))"
  (defun *error* (msg / i%)
    (if ss (mapcar (quote entdel)
        (pickset:to-list ss)))
    (print msg)
    (pop-var)
    (princ))
  (defun dxf (ent i)
    (if (= (type ent)
        (quote ename))
      (setq ent (entget ent)))
    (cdr (assoc i ent)))
  (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_background (p1 p2 p3 p4)
    (entmakex (list (cons 0 "SOLID")
        (cons 100 "AcDbEntity")
        (cons 62 8)
        (cons 100 "AcDbTrace")
        (cons 10 p1)
        (cons 11 p4)
        (cons 12 p2)
        (cons 13 p3))))
  (defun add_box (pts / dxfcodes)
    (setq dxfcodes (list (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 62 2)
        (cons 90 (length pts))
        (cons 70 1)
        (cons 43 0)
        (cons 38 0.0)
        (cons 39 0.0)))
    (foreach pt% pts (setq dxfcodes (append dxfcodes (list (cons 10 pt%)
            (cons 40 0.0)
            (cons 41 0.0)
            (cons 42 0.0)
            (cons 91 0)))))
    (entmakex (append dxfcodes (list (quote (210 0.0 0.0 1.0))))))
  (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 display (ent func / obj laynm name st1 st2 st3 lst h ang n box-pts text-style)
    (setq text-style "vitalhz")
    (if (null (tblsearch "style"
          text-style))
      (setq text-style (getvar "textstyle")))
    (setq obj (vlax-ename->vla-object ent))
    (setq laynm (strcat "图层:"
        (dxf ent 8)))
    (setq name (dxf ent 0))
    (setq lst (func ent))
    (if (= (quote str)
        (type lst))
      (setq lst (list lst)))
    (if (or (null lst)
        (not (listp lst)))
      (setq lst (list "Error! Not defined function.")))
    (setq lst (vl-remove nil lst))
    (setq lst (mapcar (quote @:to-string)
        lst))
    (setq ss (ssadd))
    (setq h (/ (getvar "viewsize")
        40))
    (setq ang (fx (angle (getvar "viewctr")
          pt)))
    (setq n (* 1.4 (1+ (/ (apply (quote max)
              (mapcar (quote strlen)
                lst))
            2.0))))
    (setq box-pts (list pt (setq st1 (polar pt (* 1.5 pi)
            (+ h (* 1.8 h (1+ (length lst))))))
        (polar st1 0 (* n h))
        (polar pt 0 (* n h))))
    (ssadd (apply (quote add_background)
        box-pts)
      ss)
    (ssadd (add_box box-pts)
      ss)
    (setq st2 (polar pt 0 (/ (* n h)
          2)))
    (setq n -1)
    (repeat (length lst)
      (ssadd (add_text (setq st2 (polar st2 (* 1.5 pi)
              (* 1.8 h)))
          h 0 (nth (setq n (1+ n))
            lst)
          text-style 1)
        ss)))
  (push-var)
  (command "_.undo"
    "_m")
  (prompt "\n*** Move cursor to entity for show infomation！***")
  (setvar "osmode"
    0)
  (setvar "fillmode"
    1)
  (setvar "cmdecho"
    0)
  (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)))
                    (quote 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 (mapcar (quote entdel)
            (pickset:to-list ss)))
        (redraw ent 3)
        (display ent (eval func))
        (setq entold ent))))
  (if entold (redraw entold 4))
  (if ss (mapcar (quote entdel)
      (pickset:to-list ss)))
  (pop-var)
  (princ))

统计信息

上传记录

统计信息

上传记录 刷新

上传记录