闭合二维多线段改起始坐标到Y最小点
本帖最后由 hoopert 于 2016-1-30 00:00 编辑;;;在明经学了很多东西，也发一个练习之作，新手，请各大侠多多指教。
;;;图一为命令运行前多线段及其起始点位置（图中红色圆圈处）
;;第二个图为运行合令后多线段及其起始点位置（红色圆圈处）
;;;改变闭合二维多线段的始点坐标到Y坐标最小的点处
(defun C:LwpolylineChangeStartpoint ()
(setq en (car (entsel "\n Select Lwpolyline:")))
(setq ed (entget en))
;;导出坐标点列表
(setq plst '())
(mapcar '(lambda (X)
(if (= 10 (car x))
(setq plst (cons (cdr x) plst))
) ;_ end of if
)
ed
)
(setq plst (reverse plst))
;;坐标点按Y最小(Y相同时，X最小）排序
(setq plst (vl-sort plst
'(lambda (a b)
(if (= (cadr a) (cadr b))
(< (car a) (car b))
(< (cadr a) (cadr b))
)
)
)
)
;;确定Y最小值点坐标，它将成为多段线的始点
(setq Startpt (car plst))
;;取出多线段实体数据的前半部分和后半部分
(setq pLst ed)
(setq Lst0 '())
(while (/= (car (car pLst)) 10)
(setq Lst0 (append Lst0 (list (car pLst))))
(setq pLst (cdr pLst))
)
(setq Lst2 (list (car (reverse pLst))))
(setq pLst (reverse (cdr (reverse pLst))))
;;各顶点循环，直到Y最小点为始点
(setq pLst1 '())
(while (/= startpt (cdr (car plst)))
(setq plst (append (cdr plst) (list (car plst))))
)
(setq Lst1 plst)
;;组成新的实体数据
(setq ed (append lst0 lst1 lst2))
;;更新实体
(entmod ed)
(princ)
);_函数结束
命令通常要在命令行输入让CAD执行，所以名称不宜太长，如果输入半天不小心输错一两个字母，给你说是未知命令，不知道楼主是否会同样郁闷 llsheng_73 发表于 2016-1-30 02:20
命令通常要在命令行输入让CAD执行，所以名称不宜太长，如果输入半天不小心输错一两个字母，给你说是未知命令 ...
理解理解，本来是要做函数用的，要发上来，随手就处理了一下，没改。多谢指点 本帖最后由 llsheng_73 于 2016-1-31 02:23 编辑
hoopert 发表于 2016-1-30 10:10 http://bbs.mjtd.com/static/image/common/back.gif
理解理解，本来是要做函数用的，要发上来，随手就处理了一下，没改。多谢指点
(defun startMiny(e / pt a p);;调整多段线起点为最南端点(多段线可有有凸度，可以各子段宽度各异)
(setq e(entget e)a(member(assoc 10 e)e)e(reverse(member(nth(1-(vl-position(car a)e))e)(reverse e))))
(repeat(cdr(assoc 90 e))
(setq p(list(car a))a(cdr a))
(while(and(/=(caar a)10)a)
(setq p(cons(car a)p)a(cdr a)))
(setq pt(cons(reverse p)pt)))
(setq p(car(vl-sort pt'(lambda(a b)(<(caddar a)(caddar b))))));;最小Y值所在的点
(entmod(append e(apply'append(append(member p(reverse pt))(reverse(cdr(member p pt)))))))
(defun c:tt(/ e a b)
(if(setq e(car(entsel)))
(progn(vla-GetBoundingBox(vlax-ename->vla-object e)'a'b)
(setq a(cadr(vlax-safearray->list a));;多段线最小Y值
a(cdar(vl-remove-if'(lambda(x)(or(/=(car x)10)(/=(caddr x)a)))(entget e))));;最小Y值所在的点(如果最南端有凸度极大可能没有对应点。。。，因此，找它的最南端点还是宜用上边函数里边的方法)
(starton e a))))
(defun starton(e p / a l pt);;多段线起点调整至指定点
(setq e(entget e)a(member(assoc 10 e)e)e(reverse(member(nth(1-(vl-position(car a)e))e)(reverse e))))
(repeat(cdr(assoc 90 e))
(setq l(list(car a))a(cdr a))
(while(and(/=(caar a)10)a)
(setq l(cons(car a)l)a(cdr a)))
(setq pt(cons(reverse l)pt)))
(setq p(assoc(cons 10(mapcar'+'(0 0)p))pt))
(entmod(append e(apply'append(append(member p(reverse pt))(reverse(cdr(member p pt))))))))
试下这个，与你自己那个比较一下，主要看下有凸度的情况 llsheng_73 发表于 2016-1-30 21:49 static/image/common/back.gif
试下这个，与你自己那个比较一下，主要看下有凸度的情况
(start e a))))
(defun starton(e p / a l pt)
是不是笔误哟！ 本帖最后由 hoopert 于 2016-2-1 00:30 编辑
llsheng_73 发表于 2016-1-30 21:49 static/image/common/back.gif
试下这个，与你自己那个比较一下，主要看下有凸度的情况
(defun c:tt(/ e a b c pl pt)
(setq e (entget (car (entsel "Please Select LWpolyline:"))))
(setq a (reverse (member (nth(1- (vl-position (assoc 10 e) e)) e) (reverse e))))
(setq b (member (assoc 10 e) e))
(setq b (reverse (member (nth (1- (vl-position (assoc 210 b) b)) b) (reverse b))))
(setq c (member (assoc 210 e) e))
(setq pl (vl-remove-if-not '(lambda(x) (= 10 (car x))) b))
(setq pt (car (vl-sort pl
'(lambda (a b)
(if (= (caddr a) (caddr b))
(< (cadr a) (cadr b))
(< (caddr a) (caddr b)))))))
(setq b (append (member pt b) (reverse (cdr (member pt (reverse b))))))
(entmod (append a b c))
(princ)
)
原来的程序对凸度的情况也没有问题。学习消化了一下，我又重新整理一遍。
最主要的是您的程序中，将210组码（及如果附有扩展数据）的顺序打乱了，我不知道这个会对多线段本身会不会有影响。
页:
[1]