[原创]这些lisp函数对你可能有用！

lyy

;;交点列表[ss-选择集]
(defun yad_inters(ss / n n1 obj1 n2 obj2 ipt l_pt)
  (setq        n (sslength ss)
        n1 0
  )
  (while (< n1 (1- n))
    (setq obj1 (vlax-ename->vla-object (ssname ss n1))
          n2 (1+ n1)
    )
    (while (< n2 n)
      (setq obj2 (vlax-ename->vla-object (ssname ss n2))
            ipt  (vlax-variant-value (vla-intersectwith obj1 obj2 0))
      )
      (if (> (vlax-safearray-get-u-bound ipt 1) 0)
        (progn
          (setq ipt (vlax-safearray->list ipt))
          (while (> (length ipt) 0)
            (setq l_pt (cons (list (car ipt) (cadr ipt) (caddr ipt)) l_pt) ipt (cdddr ipt))
          )
        )
      )
      (setq n2 (1+ n2))
    )
    (setq n1 (1+ n1))
  )
  l_pt
)
;;复合线顶点列表[en-复合线对象名或对象数据列表]
(defun yad_ptlst(en / n l_pt l_p)
  (if (not (listp en)) (setq en (entget en)))
  (setq n (vl-position (assoc 10 en) en))
  (repeat (- (length en) n)
    (if (= (car (nth n en)) 10)
      (setq l_pt (append l_pt (list (cdr (nth n en)))))
    )
    (setq n (1+ n))
  )
  (foreach n l_pt
    (if (not (vl-member-if '(lambda(x) (equal x n 0.01)) l_p))
      (setq l_p (append l_p (list n)))
    )
  )
  l_p
)
;;复合线转折点列表[l_pt-复合线顶点列表]
(defun yad_cptlst(l_pt / l_pv p1 p2 ang ang1 n p pd)
  (setq l_pt (append l_pt (list (car l_pt)))
        l_pv (list (setq p1 (nth 0 l_pt)) (setq p2 (nth 1 l_pt)))
        ang (angle p1 p2)
        ang1 ang
        n 2
  )
  (while (setq p (nth n l_pt))
    (setq pd p2)
    (if (equal ang (angle p2 p) 0.01)
      (setq l_pv (subst p p2 l_pv)
            p2 p
      )
      (setq ang (angle p2 p)
            p2 p
            l_pv (append l_pv (list p))
      )
    )
    (setq n (1+ n))
  )
  (if (equal ang1 (angle pd p2) 0.01)
    (setq l_pv (vl-remove p2 l_pv))
    (setq l_pv (reverse (cdr (reverse l_pv))))
  )
  l_pv
)
;;求屏幕两对角点
(defun yad_viewpt(/ a b c d x)
  (setq b (getvar "viewsize")
        c (car (getvar "screensize"))
        d (cadr (getvar "screensize"))
        a (* b (/ c d))
        x (trans (getvar "viewctr") 1 2)
        c (trans (list (- (car x)  (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0) 2 1)
        d (trans (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) 2 1)
  )
  (list c d)
)
;;生成无名组[lst-要成组的对象列表]
(defun yad_group(lst / en1 name en ent)
  (setq lst (mapcar '(lambda(e) (cons 340 e)) lst))
  (setq en1 (dictsearch (namedobjdict) "ACAD_GROUP"))
  (if (member (cons 3 "*A1") en1)
    (setq name (strcat "*A" (itoa (1+ (atoi (substr (cdr (assoc 3 (reverse en1))) 3))))))
    (setq name "*A1")
  )
  (setq en (list (cons 0 "GROUP") (cons 102 "{ACAD_REACTORS")
                 (cons 330 (dxf en1 -1)) (cons 102 "}")
                 (cons 100 "AcDbGroup") (cons 70 1) (cons 71 1)
            )
  )
  (setq ent (entmakex (append en lst))
        en1 (append en1 (list (cons 3 name) (cons 350 ent)))
  )
  (entmod en1)
)
;;缩放屏幕确保对象在屏幕内[lst-对象顶点列表]
(defun yad_zoom(lst / maxmin lsttrans a b zmpt)
  (defun maxmin(lst / x n a b c d)
    (setq x (car lst)
          a (car x)
          b (cadr x)
          c (car x)
          d (cadr x)
          n 1
    )
    (repeat (max (- (length lst) 1) 0)
      (setq x (nth n lst)
            a (min a (car x))
            b (min b (cadr x))
            c (max c (car x))
            d (max d (cadr x))
            n (1+ n)
      )
    )
    (list (list a b) (list c d))
  )
  (defun lsttrans(lst a b / lst2 c n)
    (setq n 0)
    (repeat (length lst)
      (setq c (trans (nth n lst) a b)
            lst2 (append lst2 (list c))
            n (1+ n)
      )
    )
    lst2
  )
  (setq lst (maxmin (lsttrans lst 1 2))
        a (car lst)
        b (cadr lst)
        lst (list (list (- (car a) 4000) (- (cadr a) 4000)) (list (+ (car b) 4000) (+ (cadr b) 4000)))
        a (maxmin (lsttrans (viewpnts) 1 2))
        b (maxmin (append a lst))
        zmpt (list (trans (append (car b) '(0.0)) 2 1) (trans (append (cadr b) '(0.0)) 2 1))
  )
  (command "_.zoom" "_w" (car zmpt) (cadr zmpt))
  zmpt
)
;;检查对话框输入数值的合法性[title-对话框 maxint-最大值 minint-最小值 oldval-原来的值]
(defun yad_chkval(title maxint minint oldval / val)
  (setq val (atof (get_tile title)))
  (if (>= maxint val minint)
    (set_tile title (rtos val))
    (set_tile title oldval)
  )
)
;;检查整数输入的合法性[pmt-提示 defval-缺省值 maxint-最大值 minint-最小值]
(defun yad_chkint(pmt defval maxint minint / val pd)
  (if (/= defval "no") (setq pmt (strcat pmt "<" defval ">") defval (atoi defval)))
  (setq pd T)
  (while (and pd (setq val (getint pmt)))
    (if (>= maxint val minint)
      (setq pd nil val val)
      (prompt "输入无效！")
    )
  )
  (if (and (/= defval "no") (not val)) (setq val defval))
  (if (>= maxint val minint)
    val
    (if (/= defval "no")
      (prompt "\n缺省值无效！")
    )
  )
)
;;选择集合并[oldss-原选择集 ss-被合并的选择集]
(defun yad_ssadd(oldss ss / n)
  (setq n -1)
  (repeat (sslength ss)
    (ssadd (ssname ss (setq n (1+ n))) oldss)
  )
  oldss
)
;;选择点特征的对象[dis-允许的距离范围 x-序号列表 y-点列表 z-其它过滤列表]
(defun yad_ssget(dis x y z / n m)
  (setq z (append z '((-4 . "<or"))))
  (setq n 0)
  (repeat (length x)
    (setq m 0)
    (repeat (length y)
      (setq z (append z (list(cons -4 "<and")
                             (cons -4 "<=,<=")
                             (cons (nth n x)
                                   (mapcar '(lambda(e) (+ e dis)) (nth m y))
                             )
                             (cons -4 ">=,>=")
                             (cons (nth n x)
                                   (mapcar '(lambda(e) (- e dis)) (nth m y))
                             )
                             (cons -4 "and>")
                        )
              )
      )
      (setq m (1+ m))
    )
    (setq n (1+ n))
  )
  (setq z (append z '((-4 . "or>"))))
  (ssget "x" z)
)
;;修改对象[en-对象名或对象数据列表 n-序号 new-新值]
(defun yad_chgent(en n new)
  (if (not (listp en)) (setq en (entget en)))
  (if (assoc n en)
    (setq en (subst (cons n new) (assoc n en) en))
    (setq en (append en (list (cons n new))))
  )
  (entmod en)
)
;;删除表的指定位置项[nm-位置 lst-表]
(defun yad_remove(nm lst / n newlst)
  (setq n 0)
  (repeat (length lst)
    (if (/= nm n)
      (setq newlst (append newlst (list (nth n lst))))
    )
    (setq n (1+ n))
  )
  newlst
)
;;字符串转列表[str-字符串 st-标志字符]
(defun yad_str2lst(str st / lst)
  (setq str (strcat str st))
  (while (vl-string-search st str)
    (setq lst (append lst (list (substr str 1 (vl-string-search st str)))))
    (setq str (substr str (+ (1+ (strlen st)) (vl-string-search st str))))
  )
  (if lst (mapcar '(lambda(e) (vl-string-trim " " e)) lst))
)
;;直接使用ACAD命令
(defun yad_comd()
  (setvar "cmdecho" 1)
  (while (/= 0 (getvar "cmdactive")) (command pause))
  (setvar "cmdecho" 0)
)

寒潮大冬瓜

感谢分享！是需要逐个消化的！在运用中领悟！

lyy

;;
;;yad_comd函数的使用例子
;;
(if (setq p1 (getpoint "\n请点取建筑轮廓线的起点："))
  (progn
    (setvar "cmdecho" 1)
    (command "_.pline" p1 "_w" "50" "")
    (prompt "\n使用 PLINE命令继续绘制建筑轮廓线！")
    (yad_comd);;试试没有这个函数会怎么样
    (alert "test ok!")
    ;;可增加后续代码
  )
)

citykunan

能不能把它的用途说的详细点？
谢谢。

fawn_lgc

继续努力

didini

怎么用啊？

killer9806

强哦,真的高手太多,让我这种菜鸟人物有点进步

hhh454

有了这些函数就方便多了。谢谢楼主

zaocha

看不懂。顶一下

jerryandrex

眼花缭乱

nuts26173802

眼睛都卡不清楚东西了