一些函数，别人的
(DEFUN C:TEST1(/ ENT LST SS)(SETQ ENT(ENTGET(CAR(ENTSEL))))
(SETQ LST(MAPCAR'CDR(VL-REMOVE-IF-NOT'(LAMBDA(X)(= 10 (CAR X)))ENT)))
(SETQ SS(SSGET "WP" LST))
(SSSETFIRST nil SS)
)
(defun plinexy(e)
(mapcar'cdr(vl-remove-if'(lambda(x)(/=(car x)10))(entget e)))
)
(setq pzx (ssget "wp" (plinexy (car (entsel))) '((0 . "polyline") (8 . "sjw") ) ));选择多段线内实体
(sssetfirst nil pzx)
(vla-ScaleEntity (vlax-ename->vla-object ss_name) (vla-get-InsertionPoint (vlax-ename->vla-object ss_name)) beishu) ;块原地缩小
;(setq ss (ssdel ss_name ss))
(entmod (append (vl-remove-if '(lambda(x) (member (car x) '(41 42 43))) pzx121)(list '(41 . 0.02) '(42 . 0.02) '(43 . 0.02) )));替换多项 (defun xyp-SS2List (ss / i s1 lst)
(cond ((= (type ss) 'PICKSET)
(setq lst (reverse (ssnamex ss))
lst (vl-remove-if-not
'(lambda (x) (equal (type (cadr x)) 'ENAME))
lst
)
lst (mapcar 'cadr lst)
)
)
((= (type ss) 'ENAME) (setq lst (list ss)))
((= (type ss) 'LIST)
(foreach s1 ss (setq lst (append (xyp-SS2List s1) lst)))
)
)
)
;; tt(删除重复直线)
;; 重复定义：起点、终点、图层
(defun c:tt ()
(setq ss (ssget '((0 . "line")))
lst(xyp-ss2list ss)
lst(mapcar '(lambda (x)
(list
(vl-remove-if-not
'(lambda (y) (member (car y) '(10 11 8)))
(entget x)
)
x
)
)
lst
)
lst1 '()
)
(foreach a lst
(setq b (car a))
(if (not (member b lst1))
(setq lst1 (cons b lst1))
(entdel (cadr a))
)
)
(princ)
);;;院长的 ..论坛里面没有吗
;释放所有obj对象
(defun cx-ReleaseObject ( obj )
(and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj))
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vlax-release-object (list obj))
)
)
)
)
hao a ,人才辈出 。 谢谢……………… (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(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))
本帖最后由 树櫴希德 于 2023-6-8 11:55 编辑
(defun plxyz(e fun / pt p n);多段线节点三维坐标，连续重合点只取一个，根据fuz阀值过滤接近点
(or(=(type e)'vla-object)(setq e(vlax-ename->vla-object e)))
(cond((=(setq n(vlax-get-property e'objectname))"AcDbLine")
(list(vlax-curve-getstartpoint e)(vlax-curve-getendpoint e)))
((WCMATCH n"*Polyline")
(repeat(setq n(fix(+(vlax-curve-getendparam e)(if(=(vlax-get-property e'Closed):vlax-true)0 1))))
(or(equal(setq n(1- n)p(vlax-curve-getpointatparam e n))(car pt)fun)
(setq pt(cons p pt))))
(if(equal(car pt)(last pt)fun)
(butlast pt)pt))))
(defun nodekill(e fuz / area pt p1 p2 mj p a b c i l n 1-N Ntriangle);;;控制面积变化率精简多段线节点
(defun 1-N(fun i n / a);;;第i点的前一个(fun -)或后一个(fun +)有效点
(while(not(nth(setq i(cond((<= 0(setq a(fun i 1))n)a)((> a n)0)((MINUSP A)N)))pt)))i)
(defun Ntriangle(i n / a b c d p1 p2 p3 p4 area);去掉第i点，重组相邻三角形数据
(setq b(1-n - i n)a(1-n - b n)
c(1-n + i n)d(1-n + c n)
p1(nth a pt)p2(nth b pt)p3(nth c pt)p4(nth d pt)
pt(subst nil(nth i pt)pt))
(list(List b a c(setq area(2area(List p2 p1 p3)))(/(abs area)(distance p1 p3)))
(List c b d(setq area(2area(List p3 p2 p4)))(/(abs area)(distance p2 p4)))))
(setq pt(plxyz e 1e-8)area(vlax-curve-getarea e)darea(* area fuz 2)mj 0 n(1-(length pt))
p1(vl-sort(mapcar(function(lambda(x / i j k a b c)
(setq i(vl-position x pt)j(1-N - i n)k(1-N + i n)
b(nth j pt)c(nth k pt)a(2area(List x b c)))
(List i j k a(/(abs a)(distance b c)))))pt)
(function(lambda(x y)(<(last x)(last y))))))
(while(equal mj 0 darea)
(if(equal(setq a(car p1)mj(+ mj(cadddr a)))0 darea)
(setq b(assoc(cadr a)p1)p1(vl-remove a p1)p1(vl-remove b p1)
p1(vl-sort(append(Ntriangle(car a)n)(vl-remove(assoc(caddr a)p1)p1))(function(lambda(x y)(<(last x)(last y))))))))
(vl-remove 'nil pt))(defun 2area(pt)(apply'+(mapcar'(lambda(x y)(-(*(car x)(cadr y))(*(car y)(cadr x))))(cons(last pt)pt)pt))) (defun plputCoordinates(e pt / n arr p1 p2);三维坐标更新多段线
(or(=(type e)'vla-object)(setq e(vlax-ename->vla-object e)))
(setq n(if(WCMATCH(vlax-get-property e'objectname)"AcDb#dPolyline")3 2)
p1(car pt)p2(cadr pt)
pt(apply'append(if(= n 2)(mapcar(function(lambda(x)(list(car x)(cadr x))))pt)pt))
arr(vlax-make-safearray vlax-vbDouble(cons 0(1-(length pt)))))
(vlax-safearray-fill arr pt)
(vlax-put-property e'Coordinates arr)
)
(defun plxyz(e fun / pt p n);多段线节点三维坐标，连续重合点只取一个，根据fuz阀值过滤接近点
(or(=(type e)'vla-object)(setq e(vlax-ename->vla-object e)))
(cond((=(setq n(vlax-get-property e'objectname))"AcDbLine")
(list(vlax-curve-getstartpoint e)(vlax-curve-getendpoint e)))
((WCMATCH n"*Polyline")
(repeat(setq n(fix(+(vlax-curve-getendparam e)(if(=(vlax-get-property e'Closed):vlax-true)0 1))))
(or(equal(setq n(1- n)p(vlax-curve-getpointatparam e n))(car pt)fun)
(setq pt(cons p pt))))
(if(equal(car pt)(last pt)fun)
(butlast pt)pt))))
(setq e (car (entsel "\n选择多段线:"))) (plputCoordinates e (plxyz e 0.001 ))
页:
[1]