Gu_xl 发表于 2014-2-13 19:57 static/image/common/back.gif
这就是一个分组、排序的问题！可以是任意角度任意方向！
按行列分组没问题...但任意角度怎么分组...G版来个范例呗,给新人个学习的机会,谢谢了!
问题还没解决，期待高人！！
任意角度一样的，我说的左边右边，是指的相对图块的左右侧，先读取图块的角度，然后逆时针90°作为左边，顺时针90°作为右边。思路我是有，只不过水平有限，暂时还没有空去编写这个程序，对大家来说可能容易解决，对我是个大工程，我觉得我的思路是完全可以做到的
本帖最后由 Gu_xl 于 2014-2-18 08:55 编辑
车位可以是任意方向、任意组合，自动忽略重合的车位！
;;绘制车位定位点 By Gu_xl 明经通道 2014.02.16
(defun c:cwdw(/ SS RESULT SSLIST OBJ P1 P2 LST
LL ANG VEC L FLAG N CNT CP
TOTALWIDE JJ STP E el name xs ys zs)
(while (and (setq e (car (entsel "\n样本车位:")))
(= "INSERT" (gxl-dxf e 0))
)
(redraw e 3)
(setq el (entget e))
(setq name (assoc 2 el)
xs (assoc 41 el)
ys (assoc 42 el)
zs (assoc 43 el)
)
(setq ss (ssget (list '(0 . "insert") name xs ys zs))
RESULT nil
)
(redraw e 4)
(if ss
(progn
(setq sslist (gxl-SEL-SS->LIST ss))
(setq obj (vla-copy (vlax-ename->vla-object (car sslist))))
(vla-put-Rotation obj 0)
(vla-GetBoundingBox obj 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
)
(mapcar 'set '(w h) (mapcar '- p2 p1))
(vla-delete obj)
(setq sslist
(vl-sort sslist
'(lambda (a b)
(< (gxl-NUM-TANG (gxl-dxf a 50) pi)
(gxl-NUM-TANG (gxl-dxf b 50) pi)
)
)
)
)
(setq lst nil
ll (list (car sslist))
sslist (cdr sslist)
)
(while sslist
(if (equal (gxl-NUM-TANG (gxl-dxf (car ll) 50) pi)
(gxl-NUM-TANG (gxl-dxf (car sslist) 50) pi)
1e-6
)
(setq ll (append ll (list (car sslist)))
sslist (cdr sslist)
)
(setq lst (cons ll lst)
ll (list (car sslist))
sslist (cdr sslist)
)
)
)
(if ll
(setq lst (cons ll lst))
)
(foreach llst
(setq ang (gxl-num-tang (gxl-dxf (car l) 50) pi)
vec (list (cos ang) (sin ang) 0)
)
(setq l (mapcar
'(lambda (x)
(list x (trans (gxl-GETBOXCENTER x) 0 vec)))
l
)
l (vl-sort
l
'(lambda (a b)
(if (equal (caadr a) (caadr b) 10.0)
(< (caddr (cadr a)) (caddr (cadr b)))
(< (caadr a) (caadr b))
)
)
)
)
(setq ll (list (car l))
l(cdr l)
)
(while l
(if (setq flag (equal (caadar l) (caadar ll) 10.0))
(setq ll (append ll (list (car l)))
l(cdr l)
)
)
(if (not flag)
(progn
;;保存同向同组车位
(setq result (cons ll result))
(if l
(setq ll (list (car l))
l(cdr l)
)
)
)
)
)
(if ll
(setq result (cons ll result))
)
)
(foreach lresult
(setq ll (list (car l))
l(cdr l)
)
(while l
(if
(or
(equal
(rem (- (caddr (cadar l)) (caddr (cadar ll)))
w)
0
10.0
)
(equal
(rem (- (caddr (cadar l)) (caddr (cadar ll)))
w)
w
10.0
)
)
(progn
(if
(not (equal (cadar l) (cadr (last ll)) 10))
(setq ll (append ll (list (car l)))
l(cdr l)
)
(setq l (cdr l))
)
)
(progn
(setq n (length ll)
cnt (/ (1+ n) 2)
ang (gxl-num-tang (gxl-dxf (caar ll) 50) pi)
vec (list (cos ang) (sin ang) 0)
)
(cond
((= 1 cnt)
(setq cp (mapcar '*
'(0.5 0.5 0.5)
(mapcar '+
(cadar ll)
(cadr (last ll)))
)
cp (trans cp vec 0)
)
(entmake
(list
'(0 . "circle")
(cons 10 cp)
(cons 40 250)
(cons 62 1)
(cons 370 40)
)
)
)
(t
(setq totalwide
(+
w
(abs
(- (caddr (cadr (last ll)))
(caddr (cadr (car ll)))
)
)
)
)
(setq jj (/ totalwide cnt))
(setq stp (cadar ll)
stp (list (car stp)
(cadr stp)
(+ (caddr stp)
(* -0.5 w)
(* 0.5 jj))
)
)
(repeat cnt
(entmake
(list
'(0 . "circle")
(cons 10 (trans stp vec 0))
(cons 40 250)
(cons 62 1)
(cons 370 40)
)
)
(setq stp
(list (car stp)
(cadr stp)
(+ (caddr stp) jj))
)
)
)
)
(setq ll (list (car l))
l(cdr l)
)
)
)
)
(if ll
(progn
(setq n (length ll)
cnt (/ (1+ n) 2)
ang (gxl-num-tang (gxl-dxf (caar ll) 50) pi)
vec (list (cos ang) (sin ang) 0)
)
(cond
((= 1 cnt)
(setq cp (mapcar
'*
'(0.5 0.5 0.5)
(mapcar '+ (cadar ll) (cadr (last ll)))
)
cp (trans cp vec 0)
)
(entmake
(list
'(0 . "circle")
(cons 10 cp)
(cons 40 250)
(cons 62 1)
(cons 370 40)
)
)
)
(t
(setq totalwide
(+
w
(abs (- (caddr (cadr (last ll)))
(caddr (cadr (car ll)))
)
)
)
)
(setq jj (/ totalwide cnt))
(setq stp (cadar ll)
stp (list
(car stp)
(cadr stp)
(+ (caddr stp) (* -0.5 w) (* 0.5 jj))
)
)
(repeat cnt
(entmake
(list
'(0 . "circle")
(cons 10 (trans stp vec 0))
(cons 40 250)
(cons 62 1)
(cons 370 40)
)
)
(setq
stp (list (car stp)
(cadr stp)
(+ (caddr stp) jj))
)
)
)
)
)
)
)
)
)
)
(princ)
)
;;一些子程序
(defun gxl-Sel-SS->List (ss / i s)
(if ss
(repeat (setq i (sslength ss))
(setq s (cons (ssname ss (setq i (1- i))) s))
)
)
)
(defun gxl-Num-TAng(ang sty / n)
(setq n (rem (+ (* 2 pi) ang) sty))
(if (equal n sty 1e-6)
0.0
n
)
)
(defun gxl-dxf (ent i)
(cond ((= (type ent) 'ename)
(cdr (assoc i (entget ent '("*"))))
)
((= (type ent) 'list)
(cdr (assoc i ent))
)
)
)
(defun gxl-getboxCenter (e1 / obj minpoint maxpoint)
(if (= 'ENAME (type e1))
(setq obj (vlax-ename->vla-object e1))
(setq obj e1)
)
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq minpoint (vlax-safearray->list minpoint))
(setq maxpoint (vlax-safearray->list maxpoint))
(mapcar '* '(0.5 0.5 0.5) (mapcar '+ minpoint maxpoint))
)
Gu_xl 发表于 2014-2-16 22:12 static/image/common/back.gif
车位可以是任意方向、任意组合，自动忽略重合的车位！
内容需要发帖数高于 30 才可浏览
G版出手，必能解决问题。。
Gu_xl 发表于 2014-2-16 22:12 static/image/common/back.gif
车位可以是任意方向、任意组合，自动忽略重合的车位！
G版：
非常感谢！
本帖最后由 感激过去 于 2014-2-17 15:22 编辑
Gu_xl 发表于 2014-2-16 22:12 static/image/common/back.gif
车位可以是任意方向、任意组合，自动忽略重合的车位！
现在我测试了，基本99%的情况能解决。不过我想反馈点情况，你查看下附件，有个别车位不能识别，是不是块有问题呢？希望能修改得更完善。
再者，希望能更改为输入指定图块（图例），不要直接放圆圈。输入命令后，先提示选择图块（图例），然后再根据我选择的任意图块（图例）布置，位置也是圆圈所在的位置，而且要放在新建单独一个层。图块和车位的关系垂直。
谢谢！！
Gu_xl 发表于 2014-2-16 22:12 static/image/common/back.gif
车位可以是任意方向、任意组合，自动忽略重合的车位！
等啊等啊等···
等到一个好朋友···
【怎么都不上线了】
感激过去 发表于 2014-2-17 15:00
现在我测试了，基本99%的情况能解决。不过我想反馈点情况，你查看下附件，有个别车位不能识别，是不是块有 ...
我已提供基本的算法，剩下的细化成合适自己具体要求的，还需要你自己努力去完成，恕我我不能一一满足你的全部要求！
我的理念是：授人以鱼不如授人以渔！