三维多段线手工输入某点高程
三维多段线手工输入某点高程，其实特性栏也能输入
;论坛长老：baitang36看了一下生成的临时文件，是我的风格 稍微改一下，把函数明前加个前缀“syz-”，这样激活后的隐藏函数就可以和原有的函数同时使用了。如隐藏函数princ变成了syz-princ,避免了冲突
;;例子：(try-load-hide-fun "get-logical-drives")
(defun try-load-hide-fun (fun / dat file fo len)
(setq fun1 (strcat "syz-" fun))
(setq len(+ (* 2(strlen fun))32));长度
(setq file (vl-filename-mktemp "tryhi.fas"))
(setq dat
(append
'(266 70 65 83 52 45 70 73 76 69 32 59 98 121 58 116 114
121 104 105 32 13 266 49 13 266 49 32 36 32 36 13 266)
(vl-string->list (itoa len))
'(32 52 32 36 20 1 1 1 256 219)
(vl-string->list fun1)
'(256 256 214)
(vl-string->list fun)
'(256 256 1 67 256 256 2 256 266 266 131 1 256 160 134 256 256 1 22 36 59 98 121 58 180 243 186 163)
)
)
(setq fo (open file "w"))
(foreach x dat (write-char x fo))
(close fo)
(load file)
(vl-file-delete file);删除临时文件
(eval(read fun1));如果函数不存在则返回nil
)
(try-load-hide-fun "nthcdr")
(defun mposition(lst ens / n);;;列出ens表内各个元素的lst中所有出现位置
(setq n(length lst))
(mapcar(function(lambda(x / i l l1)
(setq l lst)
(while(setq i(vl-position x l))
(setq l1(cons(+ i n(-(length l)))l1)
l(syz-nthcdr(1+ i)l)))
(reverse l1)))ens))
;;;;;;;;;;;;;;;;
(defun everyposition(lst / n l2);;;lst表内各元素在表内所有出现位置，可进一步用于去重、频数统计等
(setq n(length lst)m -1)
(vl-every(function(lambda(x / i l l1 )
(or(assoc x l2)
(progn
(setq l lst)
(while(setq i(vl-position x l))
(setq l1(cons(+ i n(-(length l)))l1)
l(syz-nthcdr(1+ i)l)))
(setq l2(cons(cons x(reverse l1))l2))))))lst)
(reverse l2))
;EVERYPOSITION
;_$ (EVERYPOSITION'(a b e f c d a h c f b d h i))
;((A 0 6) (B 1 10) (E 2) (F 3 9) (C 4 8) (D 5 11) (H 7 12) (I 13))
;(mposition'(154 478 123 999) '(123))
(defun vxs (e / i v lst ppp)
(setq i 0)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(setq ppp (reverse lst) )
(append (list(vlax-curve-getpointatparam e 0)) ppp )
)
(defun c:3dgc ( / Polyline PolylineObj p1 gcc xhcoordtemp0 temp1)
(vl-load-com)
(setq Polyline (car(entsel "\n请选择3维多段线")))
(setq PolylineObj (vlax-ename->vla-object Polyline ) )
(while (setq p1 (getpoint "\n请点需要输入新高程的坐标点:"))
(setq gcc (getreal "\n请输入该点新高程："))
;(mposition(vxs Polyline) p1) (everyposition (vxs Polyline) )(caar '((1355.88 1061.66 152.0) 0) )
;;;(vxs (car(entsel "\n请选择3维多段线"))) (list (car p1)(cadr p1 ))(cadar '((1355.88 1061.66 152.0) 0) )
(foreach x(everyposition (vxs Polyline) )
(if (< (distance (list (caar x ) (cadar x ) ) (list (car p1) (cadr p1)) )0.100)
(setq xh (cadr x) )
;(setq xh nil )
)
);;;;;;
;; 找出第一个索引位置的坐标
(setq coord(vla-get-Coordinate PolylineObjxh))
;;; 改变坐标
;(setq temp(+ (vlax-safearray-get-element (vlax-variant-value coord) 0) 1))
(setq temp0 (car p1)
temp1(cadr p1)
)
(setq coord(vlax-variant-value coord))
(vlax-safearray-put-element coord 0 temp0)
(vlax-safearray-put-element coord 1 temp1)
(vlax-safearray-put-element coord 2 gcc)
(vla-put-Coordinate PolylineObj xh coord)
(vla-Update PolylineObj)
;;;;;;;
)
(princ)
)
: (setq a'((100 252 36) (457 878 21) (211 985 24)))
((100 252 36) (457 878 21) (211 985 24))
命令: 'VLIDE
命令:
命令: 'VLIDE
命令:
命令: (setq n (length a))
3
命令: 'VLIDE
命令:
命令: (apply 'append (mapcar'(lambda(x)(setq a(cdr a)) (list(cons (- n (length
a)) x)))a))
((1 100 252 36) (2 457 878 21) (3 211 985 24))
为表中每个元素前插入序号
_$ (setq a'("a" "b" "c"))
("a" "b" "c")
_$ (setq n (length a))
3
_$ (apply 'append (mapcar'(lambda(x)(setq a(cdr a))(list (- n (length a)) x))a))
(1 "a" 2 "b" 3 "c")
(setq i 0)(apply'append(mapcar'(lambda(x)(List(setq i(1+ i))x))a))
;论坛长老：baitang36看了一下生成的临时文件，是我的风格 稍微改一下，把函数明前加个前缀“syz-”，这样激活后的隐藏函数就可以和原有的函数同时使用了。如隐藏函数princ变成了syz-princ,避免了冲突
;;例子：(try-load-hide-fun "get-logical-drives")
(defun try-load-hide-fun (fun / dat file fo len)
(setq fun1 (strcat "syz-" fun))
(setq len(+ (* 2(strlen fun))32));长度
(setq file (vl-filename-mktemp "tryhi.fas"))
(setq dat
(append
'(266 70 65 83 52 45 70 73 76 69 32 59 98 121 58 116 114
121 104 105 32 13 266 49 13 266 49 32 36 32 36 13 266)
(vl-string->list (itoa len))
'(32 52 32 36 20 1 1 1 256 219)
(vl-string->list fun1)
'(256 256 214)
(vl-string->list fun)
'(256 256 1 67 256 256 2 256 266 266 131 1 256 160 134 256 256 1 22 36 59 98 121 58 180 243 186 163)
)
)
(setq fo (open file "w"))
(foreach x dat (write-char x fo))
(close fo)
(load file)
(vl-file-delete file);删除临时文件
(eval(read fun1));如果函数不存在则返回nil
)
(try-load-hide-fun "nthcdr")
(defun mposition(lst ens / n);;;列出ens表内各个元素的lst中所有出现位置
(setq n(length lst))
(mapcar(function(lambda(x / i l l1)
(setq l lst)
(while(setq i(vl-position x l))
(setq l1(cons(+ i n(-(length l)))l1)
l(syz-nthcdr(1+ i)l)))
(reverse l1)))ens))
;;;;;;;;;;;;;;;;
(defun everyposition(lst / n l2);;;lst表内各元素在表内所有出现位置，可进一步用于去重、频数统计等
(setq n(length lst)m -1)
(vl-every(function(lambda(x / i l l1 )
(or(assoc x l2)
(progn
(setq l lst)
(while(setq i(vl-position x l))
(setq l1(cons(+ i n(-(length l)))l1)
l(syz-nthcdr(1+ i)l)))
(setq l2(cons(cons x(reverse l1))l2))))))lst)
(reverse l2))
;EVERYPOSITION
;_$ (EVERYPOSITION'(a b e f c d a h c f b d h i))
;((A 0 6) (B 1 10) (E 2) (F 3 9) (C 4 8) (D 5 11) (H 7 12) (I 13))
;(mposition'(154 478 123 999) '(123))
(defun vxs (e / i v lst ppp)
(setq i 0)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(setq ppp (reverse lst) )
(append (list(vlax-curve-getpointatparam e 0)) ppp )
)
(defun c:3dgcd ( / Polyline PolylineObj p1 gcc xhcoordtemp0 temp1aaa n xdb)
(vl-load-com)
(setq Polyline (car(entsel "\n请选择3维多段线")))
(setq PolylineObj (vlax-ename->vla-object Polyline ) )
(while (setq p1 (getpoint "\n请点需要输入新高程的坐标点:"))
(setq gcc (getreal "\n请输入该点新高程："))
;(mposition(vxs Polyline) p1) (everyposition (vxs Polyline) )(caar '((1355.88 1061.66 152.0) 0) )
;;;(vxs (car(entsel "\n请选择3维多段线"))) (list (car p1)(cadr p1 ))(cadar '((1355.88 1061.66 152.0) 0) )
(setq aaa (vxs Polyline) ) (setq n (length aaa))
(setq xdb (apply 'append (mapcar'(lambda(x)(setq aaa(cdr aaa)) (list(cons (- n (length aaa)) x)))aaa)))
(foreach xxdb
(if (< (distance (list (nth 1 x) (nth 2 x) ) (list (car p1) (cadr p1)) )0.0500)
(setq xh (-(car x) 1))
;(setq xh nil )
)
);;;;;;
;; 找出第一个索引位置的坐标
(setq coord(vla-get-Coordinate PolylineObjxh))
;;; 改变坐标
;(setq temp(+ (vlax-safearray-get-element (vlax-variant-value coord) 0) 1))
(setq temp0 (car p1)
temp1(cadr p1)
)
(setq coord(vlax-variant-value coord))
(vlax-safearray-put-element coord 0 temp0)
(vlax-safearray-put-element coord 1 temp1)
(vlax-safearray-put-element coord 2 gcc)
(vla-put-Coordinate PolylineObj xh coord)
(vla-Update PolylineObj)
;;;;;;;
)
(princ)
)
页:
[1]