工程桩编号提取坐标
;;ssPts: 1 选择集，返回图元列表;; 2 点表(1到n维 1维时key只能是x或X)，返回点表
;; 3 图元列表，返回图元列表
;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先，小y表示从小到大(注:二维点时，不能有z)
;;FUZZ: 允许误差
;;注:点表可以1到n维混合,Key长度不大于点的最小维数。
;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
;;示例3 (HH:ssPts:Sort '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)
;;本程序是在fsxm的扩展 自贡黄明儒 2013年9月9日
(defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N SORTPTS SORTSS)
;;1 点列表排序
(defun sortpts (PTS FUN xyz FUZZ)
(vl-sort pts
'(lambda (a b)
(if (not (equal (xyz a) (xyz b) fuzz))
(fun (xyz a) (xyz b))
)
)
)
)
;;2 排序
(defun sortpts1 (PTS KEY FUZZ)
(setq Key (vl-string->list Key))
(foreach xyz (reverse Key)
(cond ((< xyz 100)
(setq fun >)
(setq xyz (nth (- xyz 88) (list car cadr caddr)))
)
(T
(setq fun <)
(setq xyz (nth (- xyz 120) (list car cadr caddr)))
)
)
(setq Pts (sortpts Pts fun xyz fuzz))
)
)
;;3 本程序主程序
(cond ((= (type ssPts) 'PICKSET)
(repeat (setq n (sslength ssPts))
(if (and (setq e (ssname ssPts (setq n (1- n))))
(setq en (entget e))
)
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
)
)
(mapcar 'last (sortpts1 lst KEY FUZZ))
)
((Listp ssPts)
(cond ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
((= (type (car ssPts)) 'ENAME)
(foreach e ssPts
(if (setq en (entget e))
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
)
)
(mapcar 'last (sortpts1 lst KEY FUZZ))
)
)
)
)
)
;;*****************************************************************************通用点表排序
(defun c:gczbh1 (/ )
(setq blc (getint "\n请输入比例尺1:"))
(setvar 'userr1 blc);设置比例尺
(setq zg(* 0.002 blc));字高
(defun get_inpoint (blockname)
(setq in_point(cdr (assoc 10 (entget blockname))))
in_point
)
(setq ss (ssget '((0 . "insert"))) )
(setq jidian (getpoint "请选择基点："))
(setq fangx (getpointjidian "请选择方向点："))
(setq angle1 (* (angle jidian fangx) 1))
(command "_.rotate" ss "" jidian "r" jidian fangx (polar jidian 0 100))
(setq i 0)
(setq lst '())
(repeat (sslength ss)
(setq insert_name (ssname ss i))
(setq e(get_inpoint insert_name))
(setq lst (append lst (list e)))
(setq i (1+ i))
)
(setq ptlst (HH:ssPts:Sort lst "xyz" 0.0))
;@树櫴希德 点表按照特定点逆时针排序~
;(setq p (getpoint "\n指定排序方向"))
;(setq ptlst(mapcar 'cdr (vl-sort (mapcar 'cons (mapcar '(lambda(x) (angle x p)) lst) lst) '(lambda (x y) (< (car x) (car y))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(setq ptlst (vl-sort (reverse lst)
;以下根据x坐标对表排序
;'(lambda (e1 e2)
; (< (car e1) (car e2) )
; (= (anglee1 e2)) ) ) )
;;;;;;;;;;;;;;;;;-----------------------------------
(setq ii 1)
(setqff (open (getfiled "请输入要保存的数据文件名" "" "dat" 1) "w"))
(foreach n ptlst
(entmake (list '(0 . "text") (cons 10 n) '(7 . "HZ") (cons 40 zg)(cons 1 (rtos ii 2 0))))
(setq nn (polar jidian (+ angle1 (angle jidian n)) (distance jidian n)))
(write-line (strcat (vl-princ-to-string ii)"," ","(vl-princ-to-string (car nn)) ","(vl-princ-to-string (cadr nn))","(vl-princ-to-string (caddr nn))
) ff)
(setq ii (1+ ii))
)
(close ff)
)
(defun c:gczbh1 (/ p qianzhui blc zg ss i lst e kkkk ptlst ff )
(setq blc (getint "\n请输入比例尺1:"))
(setvar 'userr1 blc);设置比例尺
(setq zg(* 0.002 blc));字高
(defun get_inpoint (blockname)
(setq in_point(cdr (assoc 10 (entget blockname))))
in_point
)
(setq ss (ssget '((0 . "insert"))) )
;(setq jidian (getpoint "请选择基点："))
;(setq fangx (getpointjidian "请选择方向点："))
;(setq angle1 (* (angle jidian fangx) 1))
;(command "_.rotate" ss "" jidian "r" jidian fangx (polar jidian 0 100))
(setq i 0)
(setq lst '())
(repeat (sslength ss)
(setq insert_name (ssname ss i))
(setq e(get_inpoint insert_name))
(setq lst (append lst (list e)))
(setq i (1+ i))
)
;(setq ptlst (HH:ssPts:Sort lst "xyz" 0.0))
;@树櫴希德 点表按照特定点逆时针排序~
(setq p (getpoint "\n指定排序方向"))
(setq qianzhui(getstring "\n请输入前缀："))
;(setq ptlst(mapcar 'cdr (vl-sort (mapcar 'cons (mapcar '(lambda(x) (angle x p)) lst) lst) '(lambda (x y) (< (car x) (car y))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq ptlst (vl-sort (reverse lst)
;以下根据x坐标对表排序
'(lambda (e1 e2)
(< (car e1) (car e2) )
(= (anglee1 p)) ) ) )
;;;;;;;;;;;;;;;;;-----------------------------------
(initget "1 2")
(prompt "\n坐标是否缩小1000倍:")
(setq kkkk (getkword "\n 1. 不用缩小1000倍 \2. 缩小1000倍：<1>"))
(if (= kkkk nil) (setq kkkk "1"))
(setq ii 1)
(setqff (open (getfiled "请输入要保存的数据文件名" "" "dat" 1) "w"))
( cond ((= kkkk "1")
(progn
(foreach n ptlst
(entmake (list '(0 . "text") (cons 10 n) '(7 . "HZ") (cons 40 zg)(cons 1 (strcat qianzhui (rtos ii 2 0)) )))
(write-line (strcat qianzhui (vl-princ-to-string ii)"," ","(vl-princ-to-string (car n)) ","(vl-princ-to-string (cadr n))","(vl-princ-to-string (caddr n))
) ff)
(setq ii (1+ ii))
)(close ff)))
( (= kkkk "2")
(progn
(foreach n ptlst
(entmake (list '(0 . "text") (cons 10 n) '(7 . "HZ") (cons 40 (* 1000 zg))(cons 1 (strcat qianzhui (rtos ii 2 0)) )))
(write-line (strcat qianzhui (vl-princ-to-string ii)"," ","(vl-princ-to-string (/ (car n) 1000)) ","(vl-princ-to-string (/ (cadr n) 1000))","(vl-princ-to-string (/ (caddr n) 1000))
) ff)
(setq ii (1+ ii))
)(close ff)
)
)
)
) 楼主研究精神值得我们学习 楼主，不知道怎么使用。 楼主，不知道怎么使用。 楼主，你做成附件，供新手下载。比如 lgzh0008 他知道怎么使用。 楼主是孤独求败 感谢楼主分享 这个要针对桩做成块才行，还有就是原图没有标注字出来，不知道哪里搞错了 看了代码，应该字体中要有hz这个样式才行，等回去试试
页:
[1]