[分享]：【实用程序汇总】test000系列！

sunchi7749 · 发表于 2010-3-4 10:22:13

感谢楼主分享！

zzq191 · 发表于 2013-4-6 10:07:25

ghood!!!!!!!!!!!!!!!!!!!!!!!!!!!

hewenhua080518 · 发表于 2013-5-4 19:26:47

真的是好东西呢下个来看看

xyp1964 · 发表于 2013-5-7 23:13:50

;; 方框排版
(defun c:test1279 (/ i ss s1 pt)
(CMDLA0)
(princ "\n选择方框: ")
(if (and (setq ss (ssget '((0 . "*polyLINE"))))
(setq p0 (getpoint "\n基点<退出>: "))
)
(progn
(setq i -1
lst '()
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq dd (distance (xyp-9pt s1 1) (xyp-9pt s1 7))
lst (cons (list dd s1) lst)
)
)
(setq lst (vl-sort lst '(lambda (x y) (> (car x) (car y))))
lst (mapcar 'cadr lst)
)
(foreach a lst
(princ)
(xyp-move a (xyp-9pt a 1) p0)
(setq p0 (xyp-Pt2X (xyp-9pt a 3) 300))
)
)
)
(CMDLA1)
)

xyp1964 · 发表于 2013-5-7 23:16:25

;; 图层备份
(defun c:test1280 ()
(setq lst (xyp-Get-LayersColorLst)
lst2 (mapcar '(lambda (x)
(strcat (car x)
" "
(if (equal (type (setq a (cdr x))) 'INT)
(itoa a)
a
)
)
)
lst
)
)
(xyp-List2File lst2 "图层备份" "txt")
(princ)
)

tangjunasd58 · 发表于 2013-5-8 23:57:19

哪里可以下载啊！！！！！！！！！！！！:@

xyp1964 · 发表于 2013-5-12 08:26:05

;; 多段线矩形偏移
(defun c:test1281 ()
(CMDLA0)
(while (and (setq e (entsel "\n选择多段线<退出>: "))
(setq s1 (car e))
(xyp-etype s1 "*line")
)
(setq pt (osnap (cadr e) "nea")
ptn (xyp-Get-Pts&Pte e)
p1 (car ptn)
p2 (cadr ptn)
rad (angle p1 p2)
)
(setq mode t)
(while mode
(setq motion (grread t 15 0)
code (car motion)
)
(if (or (= code 2)
(= code 3)
(= code 25)
)
(setq mode nil
s2 nil
s3 nil
)
(progn
(redraw)
(setq p3 (xyp-Grvecs-Osnap (cadr motion)))
(if (xyp-CCW-CheckWith3Pt p1 p2 p3)
(setq p1a (polar p1 (- rad (* pi 0.5)) 1)
p1a (inters p1 p1a p3 (polar p3 rad 10) nil)
p2a (polar p2 (- rad (* pi 0.5)) 1)
p2a (inters p2 p2a p3 (polar p3 rad 10) nil)
)
(setq p1a (polar p1 (+ rad (* pi 0.5)) 1)
p1a (inters p1 p1a p3 (polar p3 rad 10) nil)
p2a (polar p2 (+ rad (* pi 0.5)) 1)
p2a (inters p2 p2a p3 (polar p3 rad 10) nil)
)
)
(xyp-Grvecs-Ptlst (list p1 p2 p2a p1a p1) 2)
)
)
)
(xyp-Pline (list p1 p2 p2a p1a) T)
)
(redraw)
(CMDLA1)
)

;; 多段线矩形偏移 
(defun c:test1281 () 
  (CMDLA0) 
  (while (and (setq e (entsel "\n选择多段线<退出>: ")) 
              (setq s1 (car e)) 
              (xyp-etype s1 "*line") 
         ) 
    (setq pt  (osnap (cadr e) "nea") 
          ptn (xyp-Get-Pts&Pte e) 
          p1  (car ptn) 
          p2  (cadr ptn) 
          rad (angle p1 p2) 
    ) 
    (setq mode t) 
    (while mode 
      (setq motion (grread t 15 0) 
            code   (car motion) 
      ) 
      (if (or (= code 2) 
              (= code 3) 
              (= code 25) 
          ) 
        (setq mode nil 
              s2   nil 
              s3   nil 
        ) 
        (progn 
          (redraw) 
          (setq p3 (xyp-Grvecs-Osnap (cadr motion))) 
          (if (xyp-CCW-CheckWith3Pt p1 p2 p3) 
            (setq p1a (polar p1 (- rad (* pi 0.5)) 1) 
                  p1a (inters p1 p1a p3 (polar p3 rad 10) nil) 
                  p2a (polar p2 (- rad (* pi 0.5)) 1) 
                  p2a (inters p2 p2a p3 (polar p3 rad 10) nil) 
            ) 
            (setq p1a (polar p1 (+ rad (* pi 0.5)) 1) 
                  p1a (inters p1 p1a p3 (polar p3 rad 10) nil) 
                  p2a (polar p2 (+ rad (* pi 0.5)) 1) 
                  p2a (inters p2 p2a p3 (polar p3 rad 10) nil) 
            ) 
          ) 
          (xyp-Grvecs-Ptlst (list p1 p2 p2a p1a p1) 2) 
        ) 
      ) 
    ) 
    (xyp-Pline (list p1 p2 p2a p1a) T) 
  ) 
  (redraw) 
  (CMDLA1) 
)

hihollen · 发表于 2013-5-19 23:34:03

在哪儿呢，我找不到，下载不了。

maiqi816 · 发表于 2013-5-31 10:01:42

好东西呀好东西呀

maiqi816 · 发表于 2013-5-31 10:03:31

的确是好东东！！！！

maiqi816 · 发表于 2013-5-31 10:05:35

的确是好东东！！！！

maiqi816 · 发表于 2013-5-31 10:14:48

的确是好东东！！！！的确是好东东！！！！

yangist · 发表于 2013-6-7 07:22:47

下来试试看

清华大学 · 发表于 2013-6-7 12:11:35

学习一下吧

xyp1964 · 发表于 2013-7-4 20:04:51

;; 2013年7月3日　xjpy(线脚偏移)
(defun c:xjpy (/ s00 ptn i ss s1 j dd s0 p1 p2 s2 co)
(CMDLA0)
(if (and (setq s00 (car (entsel "\n选择线脚曲线: ")))
(xyp-etype s00 "*polyLINE")
)
(progn
(redraw s00 3)
(princ "\n选择边界曲线: ")
(if (setq ss (ssget '((0 . "*polyLINE"))))
(progn
(setq ptn (xyp-get-Vertexs s00 0)
ptn (mapcar '(lambda (x) (list 0 (cadr x))) ptn)
ptn (xyp-delsame ptn)
ptn (vl-sort ptn '(lambda (p1 p2) (> (cadr p1) (cadr p2))))
i -1
)
(xyp-MkLaCo "线脚" 8)
(while (setq s1 (ssname ss (setq i (1+ i))))
(xyp-Group0)
(setq co (xyp-get-color s1)
j 0
dd 0
s0 (entlast)
)
(while (and (setq p1 (nth j ptn))
(setq p2 (nth (setq j (1+ j)) ptn))
)
(setq dd (+ dd (distance p1 p2)))
(xyp-Offset s1 dd nil t nil)
)
(setq s2 (entlast))
(xyp-line (xyp-get-Vertexs s1 0)
(xyp-get-Vertexs s2 0)
)
(xyp-SubUpd (xyp-SSelEntnext s0) 8 "线脚")
(xyp-SubUpd s2 62 co)
(xyp-Group1)
)
)
)
(redraw s00 4)
)
)
(CMDLA1)
)

;; 2013年7月3日　xjpy(线脚偏移) 
(defun c:xjpy (/ s00 ptn i ss s1 j dd s0 p1 p2 s2 co) 
  (CMDLA0) 
  (if (and (setq s00 (car (entsel "\n选择线脚曲线: "))) 
           (xyp-etype s00 "*polyLINE") 
      ) 
    (progn 
      (redraw s00 3) 
      (princ "\n选择边界曲线: ") 
      (if (setq ss (ssget '((0 . "*polyLINE")))) 
        (progn 
          (setq        ptn (xyp-get-Vertexs s00 0) 
                ptn (mapcar '(lambda (x) (list 0 (cadr x))) ptn) 
                ptn (xyp-delsame ptn) 
                ptn (vl-sort ptn '(lambda (p1 p2) (> (cadr p1) (cadr p2)))) 
                i   -1 
          ) 
          (xyp-MkLaCo "线脚" 8) 
          (while (setq s1 (ssname ss (setq i (1+ i)))) 
            (xyp-Group0) 
            (setq co (xyp-get-color s1) 
                  j  0 
                  dd 0 
                  s0 (entlast) 
            ) 
            (while (and        (setq p1 (nth j ptn)) 
                        (setq p2 (nth (setq j (1+ j)) ptn)) 
                   ) 
              (setq dd (+ dd (distance p1 p2))) 
              (xyp-Offset s1 dd nil t nil) 
            ) 
            (setq s2 (entlast)) 
            (xyp-line (xyp-get-Vertexs s1 0) 
                      (xyp-get-Vertexs s2 0) 
            ) 
            (xyp-SubUpd (xyp-SSelEntnext s0) 8 "线脚") 
            (xyp-SubUpd s2 62 co) 
            (xyp-Group1) 
          ) 
        ) 
      ) 
      (redraw s00 4) 
    ) 
  ) 
  (CMDLA1) 
)

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

[程序发布] [分享]：【实用程序汇总】test000系列！