【e派】工具箱函数再揭秘及应用实例

magicheno

xyp1964 发表于 2012-7-30 13:52

此函数参数有BUG
(setq ss  (xyp-Ssdel sss x)
应为
(setq ss  (xyp-Ssdel sss code x)

QQ：81444317

韩飞翔

xyp1964 发表于 2018-11-16 20:59

略微修改，改成了选择集折返排序
;;测试代码
(defun c:tt ()
  (xyp-MkLaCo "箭头线" 1)
  (setq n 1)
  (setq mode (getint "\n排序类型号"))
  (while (setq ss (ssget))
    (setq
                        ptn (mapcar '(lambda (x) (xyp-9Pt x 5)) (xyp-Sort-sszf8s ss mode 5))
                        s1  (xyp-Pline ptn nil)
                        ptn (reverse ptn)
                        pt1 (car ptn)
                        pt2 (cadr ptn)
                        ang (angle pt1 pt2)
                        pt3 (polar pt1 ang 600)
                        pt4 (polar pt3 (+ ang (* 0.5 pi)) 150)
                        pt5 (polar pt3 (- ang (* 0.5 pi)) 150)
                        s2  (xyp-Pline (list pt4 pt5 pt1) t)
                        n   (1+ n)
    )
  )
  (princ)
)
;;参数:ss:选择集
;;参数:mode:排序方式
;;参数:n:9pt的位置点
;;返回:折返排序后的选择集表
(defun xyp-Sort-sszf8s (ss mode n / x y aaa)
  (defun aaa (ss fun1 fun2 n / x y x1 x2 y1 y2)
    (vl-sort (xyp-ss2list ss)
                        '(lambda (x y)
                                 (setq
                                         x         (trans (xyp-9pt x n) 0 1)
                                         y         (trans (xyp-9pt y n) 0 1)
                                         x1 (car x)
                                         x2 (car y)
                                         y1 (cadr x)
                                         y2 (cadr y)
                                 )
                                 (cond
                                         ((and (= x1 x2) (= y1 y2) (> (caddr x) (caddr y))) T)
                                         ((and (= y1 y2) (fun1 x1 x2)) T)
                                         ((fun2 y1 y2) T)
                                 )
                         )
    )
  )
  (defun bbb (ss fun1 fun2 n / x y x1 x2 y1 y2)
    (vl-sort (xyp-ss2list ss)
                        '(lambda (x y)
                                 (setq
                                         x         (trans (xyp-9pt x n) 0 1)
                                         y         (trans (xyp-9pt y n) 0 1)
                                         x1 (car x)
                                         x2 (car y)
                                         y1 (cadr x)
                                         y2 (cadr y)
                                 )
                                 (cond ((and (= x1 x2) (= y1 y2) (> (caddr x) (caddr y))) T)
                                         ((and (= x1 x2) (fun1 y1 y2)) T)
                                         ((fun2 x1 x2) T)
                                 )
                         )
    )
  )
  (cond
                ((= mode 1) (aaa ss < > n))
                ((= mode 2) (aaa ss > > n))
                ((= mode 3) (aaa ss < < n))
                ((= mode 4) (aaa ss > < n))
                ((= mode 5) (bbb ss > < n))
                ((= mode 6) (bbb ss < < n))
                ((= mode 7) (bbb ss > > n))
                ((= mode 8) (bbb ss < > n))
  )
)

Archli

学习一下，标记

xyp1964

1. (defun xyp-StrSubst (new old string / ll tx n)
   
2.   "xyp-StrSubst 在字符串中进行字符串替换 (xyp-StrSubst new old string)"
   
3.   ;; (xyp-StrSubst "abc" "3" "1234321") → "12abc4abc21"
   
4.   (if (> (setq ll (strlen old)) 0)
   
5.     (progn
   
6.       (setq tx "")
   
7.       (while (setq n (vl-string-search old string))
   
8.         (setq tx (strcat tx (substr string 1 n) new)
   
9.               string (substr string (+ n ll 1))
   
10.         )
    
11.       )
    
12.       (strcat tx string)
    
13.     )
    
14.     string
    
15.   )
    
16. )

(defun xyp-StrSubst (new old string / ll tx n)<br />   "xyp-StrSubst 在字符串中进行字符串替换 (xyp-StrSubst new old string)"<br />   ;; (xyp-StrSubst "abc" "3" "1234321") → "12abc4abc21"<br />   (if (> (setq ll (strlen old)) 0)<br />     (progn<br />       (setq tx "")<br />       (while (setq n (vl-string-search old string))<br />         (setq tx (strcat tx (substr string 1 n) new)<br />               string (substr string (+ n ll 1))<br />         )<br />       )<br />       (strcat tx string)<br />     )<br />     string<br />   )<br /> )

xyp1964

1. (defun xyp-StrSpr (str sub / lst n)
   
2.   "以指定分解符分解字符串"
   
3.   (if (/= sub "")
   
4.     (progn
   
5.       (while (setq n (vl-string-search sub str))
   
6.         (setq lst (cons (substr str 1 n) lst)
   
7.               str (substr str (+ n (strlen sub) 1))
   
8.         )
   
9.       )
   
10.       (vl-remove "" (reverse (cons str lst)))
    
11.     )
    
12.   )
    
13. )

(defun xyp-StrSpr (str sub / lst n)<br />   "以指定分解符分解字符串"<br />   (if (/= sub "")<br />     (progn<br />       (while (setq n (vl-string-search sub str))<br />         (setq lst (cons (substr str 1 n) lst)<br />               str (substr str (+ n (strlen sub) 1))<br />         )<br />       )<br />       (vl-remove "" (reverse (cons str lst)))<br />     )<br />   )<br /> )

1. (defun xyp-PtInPtn (p pt / aa)
   
2.   "xyp-PtInPtn 点在点集内 (xyp-PtInPtn pt点 ptn点集)"
   
3.   (setq aa (mapcar '(lambda (x y) (rem (- (angle x p) (angle y p)) pi))  pt (cons (last pt) pt))
   
4.         aa (abs (apply '+ aa))
   
5.   )
   
6.   (equal aa pi 1e-8)
   
7. )
   

(defun xyp-PtInPtn (p pt / aa)<br />   "xyp-PtInPtn 点在点集内 (xyp-PtInPtn pt点 ptn点集)"<br />   (setq aa (mapcar '(lambda (x y) (rem (- (angle x p) (angle y p)) pi))  pt (cons (last pt) pt))<br />         aa (abs (apply '+ aa))<br />   )<br />   (equal aa pi 1e-8)<br /> )<br />

hubeiwdlue

谢谢院长分享。

xyp1964

神奇的数学世界

bonny

xyp1964 发表于 2024-2-7 11:27
神奇的数学世界

院长威武，12年了还在跟帖

xyp1964

bonny 发表于 2024-2-7 14:14
院长威武，12年了还在跟帖

一个生肖轮回……

xyp1964

1. (defun xyp-get-Color (s1 / co)
   
2.   "xyp-get-Color 取得物体的颜色（含随层）(xyp-get-Color s1实体)"
   
3.   (if (setq co (xyp-DXF 62 s1))co(cdr (assoc 62 (tblsearch "layer" (xyp-DXF 8 s1)))))
   
4. )

(defun xyp-get-Color (s1 / co)<br />   "xyp-get-Color 取得物体的颜色（含随层）(xyp-get-Color s1实体)"<br />   (if (setq co (xyp-DXF 62 s1))co(cdr (assoc 62 (tblsearch "layer" (xyp-DXF 8 s1)))))<br /> )