本帖最后由 fangmin723 于 2022-11-12 10:00 编辑
好久没有发帖了,冒个泡!!!
- ;;说明:根据给定符号对图元表进行XY轴位置先后排序(如:先X轴升序,后Y轴降序)
- ;;适用于子表的第一个元素为点表的表集排序(((1 2 3) ...) ((4 5 6) ...) ((7 8 9) ...) ...)
- ;;参数:lst:图元表
- ;;参数:XSymbol:X轴升降序符号:<、>
- ;;参数:YSymbol:Y轴升降序符号:<、>
- ;;参数:isxfirst:是否先对X轴排序
- ;;返回:排序后的图元表!(setq hlst (SortFirstPtlSTByXAndY lshlst < > nil))(defun SortFirstPtlSTByXAndY(lst XSymbol YSymbol isxfirst / hvlst lslst rowcol symbol ud xory xy)
- (if isxfirst
- (setq
- XOrY caar;;设置第一次依据排序坐标和第二次依据X轴位置比对
- ud cadar;;设置第二次根据Y坐标进行排序
- Symbol YSymbol;;设置第二次排序的升降序
- lslst (vl-sort lst (function (lambda (x y) (XSymbol (XOrY x) (XOrY y)))));;先对表进行X轴排序
- )
- (setq
- XOrY cadar;;设置第一次依据排序坐标和第二次依据Y轴位置比对
- ud caar;;设置第二次根据X坐标进行排序
- Symbol XSymbol;;设置第二次排序的升降序
- lslst (vl-sort lst (function (lambda (x y) (YSymbol (XOrY x) (XOrY y)))))
- )
- )
- (setq rowcol nil xy (XOrY (car lslst)) hvlst nil)
- (foreach x lslst
- (if (= xy (XOrY x))
- (setq rowcol (cons x rowcol))
- (setq
- hvlst (append hvlst (vl-sort rowcol (function (lambda (x y) (Symbol (ud x) (ud y))))))
- rowcol nil rowcol (cons x rowcol) xy (XOrY x)
- )
- )
- )
- (setq hvlst (append hvlst (vl-sort rowcol (function (lambda (x y) (Symbol (ud x) (ud y)))))))
- hvlst
- )
- ;;说明:根据给定符号对图元表进行XY轴位置先后排序(如:先X轴升序,后Y轴降序)
- ;;参数:lst:图元表
- ;;参数:XSymbol:X轴升降序符号:<、>
- ;;参数:YSymbol:Y轴升降序符号:<、>
- ;;参数:isxfirst:是否先对X轴排序
- ;;返回:排序后的图元表!(setq hlst (SortLineByXAndY lshlst < > nil))
- (defun SortLineByXAndY(lst XSymbol YSymbol isxfirst / hvlst lslst rowcol symbol ud xory xy)
- (if isxfirst
- (setq
- XOrY cadr;;设置第一次依据排序坐标和第二次依据X轴位置比对
- ud caddr;;设置第二次根据Y坐标进行排序
- Symbol YSymbol;;设置第二次排序的升降序
- lslst (vl-sort lst (function (lambda (x y) (XSymbol (XOrY (assoc 10 (entget x))) (XOrY (assoc 10 (entget y)))))));;先对表进行X轴排序
- )
- (setq
- XOrY caddr;;设置第一次依据排序坐标和第二次依据Y轴位置比对
- ud cadr;;设置第二次根据X坐标进行排序
- Symbol XSymbol;;设置第二次排序的升降序
- lslst (vl-sort lst (function (lambda (x y) (YSymbol (XOrY (assoc 10 (entget x))) (XOrY (assoc 10 (entget y)))))))
- )
- )
- (setq rowcol nil xy (XOrY (assoc 10 (entget (nth 0 lslst)))) hvlst nil)
- (foreach x lslst
- (if (= xy (XOrY (assoc 10 (entget x))))
- (setq rowcol (cons x rowcol))
- (setq
- hvlst (append hvlst (vl-sort rowcol (function (lambda (x y) (Symbol (ud (assoc 10 (entget x))) (ud (assoc 10 (entget y))))))))
- rowcol nil rowcol (cons x rowcol) xy (XOrY (assoc 10 (entget x)))
- )
- )
- )
- (setq hvlst (append hvlst (vl-sort rowcol (function (lambda (x y) (Symbol (ud (assoc 10 (entget x))) (ud (assoc 10 (entget y)))))))))
- hvlst
- )
|