xyp1964 发表于 2012-7-30 13:52
此函数参数有BUG
(setq ss(xyp-Ssdel sss x)
应为
(setq ss(xyp-Ssdel sss code x)
:lol
QQ：81444317
本帖最后由 韩飞翔 于 2023-12-6 15:54 编辑
xyp1964 发表于 2018-11-16 20:59
略微修改，改成了选择集折返排序:victory:
;;测试代码
(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))
)
)
学习一下，标记
(defun xyp-StrSubst (new old string / ll tx n)
"xyp-StrSubst 在字符串中进行字符串替换 (xyp-StrSubst new old string)"
;; (xyp-StrSubst "abc" "3" "1234321") → "12abc4abc21"
(if (> (setq ll (strlen old)) 0)
(progn
(setq tx "")
(while (setq n (vl-string-search old string))
(setq tx (strcat tx (substr string 1 n) new)
string (substr string (+ n ll 1))
)
)
(strcat tx string)
)
string
)
)
本帖最后由 xyp1964 于 2024-1-24 22:29 编辑
(defun xyp-StrSpr (str sub / lst n)
"以指定分解符分解字符串"
(if (/= sub "")
(progn
(while (setq n (vl-string-search sub str))
(setq lst (cons (substr str 1 n) lst)
str (substr str (+ n (strlen sub) 1))
)
)
(vl-remove "" (reverse (cons str lst)))
)
)
)
(defun xyp-PtInPtn (p pt / aa)
"xyp-PtInPtn 点在点集内 (xyp-PtInPtn pt点 ptn点集)"
(setq aa (mapcar '(lambda (x y) (rem (- (angle x p) (angle y p)) pi))pt (cons (last pt) pt))
aa (abs (apply '+ aa))
)
(equal aa pi 1e-8)
)
谢谢院长分享。
本帖最后由 xyp1964 于 2024-2-7 13:30 编辑
神奇的数学世界
xyp1964 发表于 2024-2-7 11:27
神奇的数学世界
院长威武，12年了还在跟帖
bonny 发表于 2024-2-7 14:14
院长威武，12年了还在跟帖
一个生肖轮回……
(defun xyp-get-Color (s1 / co)
"xyp-get-Color 取得物体的颜色（含随层）(xyp-get-Color s1实体)"
(if (setq co (xyp-DXF 62 s1))co(cdr (assoc 62 (tblsearch "layer" (xyp-DXF 8 s1)))))
)