创建外轮廓线（非面域方式）
本帖最后由 feng582304 于 2011-11-15 14:13 编辑奋斗了一段时间，终于差不多完成了，自己做了简单测试，简单的图形好象还行，复杂一点的好象还是有点问题，大家帮忙看一下，谢谢！！！
;-------------------------------------------------------------------------------;
; 总执行函数 ;
;1.点最右下角的点选对象(feng-wlkx-pointtossget 点) ;
;2.对选集进行逆时针判断(feng-wlkx-ssgettominangle 模型 选集 前个节点 当前节点);
;3.通过对象选择选集(feng-wlkx-sstossget 基准对象 前一个节点 当前节点) ;
;4.对选集进行交点计算(feng-wlkx-ssgettointer 指定对象 选集 当前节点) ;
;5.重复步骤1.2.3.4，如果步骤3选集为0时，调整前一个节点，再次执行步骤2.3.4;
;6.当计算的交点与起始点重合时结束，列出((节点 对象)...) ;
;7.创建外轮廓线(feng-wlkx-makeplinelist 模型 ((节点 对象)...)) ;
;-------------------------------------------------------------------------------;
(defun c:asdf ( / ms p0 )
(setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
p0 (getpoint)
)
(feng-wlkx-run ms p0 nil nil '())
)
(defun feng-wlkx-run ( ms p0 p1 p2 pli / pointtossget sstossget ssgettointer s1 inp )
(if (and (null p1) (null p2))
(setq p2 p0
p1 (list (- (car p0) 2) (cadr p0) 0)
)
)
(setq pointtossget (FENG-WLKX-POINTTOSSGET p2))
(princ "\n-------pointtossget-------\n")
(princ pointtossget)(princ "--->>>")(princ (sslength pointtossget))
(princ "\n-------pointtossget-------\n")
(setq s1 (cadr (nth 0 (FENG-WLKX-SSGETTOMINANGLE ms pointtossget p1 p2))))
(setq sstossget (FENG-WLKX-SSTOSSGET s1 p1 p2))
(while (= (sslength (car sstossget)) 0)
(setq s1 (cadr (nth 0 (FENG-WLKX-SSGETTOMINANGLE ms pointtossget (cadr sstossget) p2)))
sstossget (feng-wlkx-sstossget s1 (cadr sstossget) p2)
)
)
(princ "\n-----p2----s1-----\n")
(princ p2)(princ "--->>")(princ s1)
(princ "\n-----p2----s1-----\n")
(setq pli (append pli (list (list p2 s1)))
inp (car (nth 0 (FENG-WLKX-SSGETTOINTER s1 (car sstossget) p2)))
)
(princ "\n--------inp-------\n")
(princ inp)
(princ "\n--------inp-------\n")
(if (<= (DISTANCE p0 inp) 1e-5)
(feng-wlkx-makeplinelist ms pli)
(progn
(setq pointtossget nil
s1 nil
sstossget nil
)
(feng-wlkx-run ms p0 p2 inp pli)
)
)
)
;-------------------------------------------------------;
;对块、多段线进行临时分解，返回临时对象列表;
; ;
;(feng-wlkx-ssget-explode 块或多段线) ;
; ;
; 返回列表(临时分解对象) ;
;-------------------------------------------------------;
;-------------------------------------------------------;
; 选择块或多段线 ;
;-------------------------------------------------------;
(defun feng-ssgettoexplode ( / ss li n na )
(setq ss (ssget '((0 . "*POLYLINE,INSERT")))
li '()
)
(if ss
(progn
(repeat (setq n (sslength ss))
(setq na (vlax-ename->vla-object (ssname ss (setq n (1- n))))
li (append li (feng-wlkx-ssget-explode na))
)
)
)
)
li
)
;-------------------------------------------------------;
; 对块或多段线进行临时分解 ;
;-------------------------------------------------------;
(defun feng-wlkx-ssget-explode ( ss / li ex na )
(setq li (setq ex (vlax-safearray->list (vlax-variant-value (vla-Explode ss)))))
(MAPCAR '(LAMBDA (x)
(if (or (= (vla-get-ObjectName x) "AcDbPolyline") (= (vla-get-ObjectName x) "AcDbBlockReference"))
(setq li (append li (feng-wlkx-ssget-explode x))) (vla-update x))
)
ex
)
li
)
;-------------------------------------------------------;
; 对选集进行逆时针判断 ;
; ;
;(feng-wlkx-ssgettominangle 模型 选集 前个节点 当前节点);
; ;
;返回排序后的(list (交点 对应的对象)...) ;
;-------------------------------------------------------;
(defun feng-wlkx-ssgettominangle ( ms ss p-1 p0 / s1 n nn cir inp li )
(setq cir (vla-AddCircle ms (vlax-3d-point p0) 2)
li '()
)
(repeat (setq n (sslength ss))
(setq s1 (vlax-ename->vla-object (ssname ss (setq n (1- n))))
inp (vlax-variant-value (vla-IntersectWith s1 cir acExtendNone))
)
(if (> (vlax-safearray-get-u-bound inp 1) 0)
(repeat (/ (setq nn (length (setq inp (vlax-safearray->list inp)))) 3)
(setq li (cons (list (list (nth (setq nn (- nn 3)) inp) (nth (+ nn 1) inp) (nth (+ nn 2) inp)) s1) li))
)
)
)
(vla-delete cir)
(setq li (vl-sort li '(LAMBDA (x y) (< (feng-3pointtoangle p-1 p0 (car x)) (feng-3pointtoangle p-1 p0 (car y))))))
)
;-------------------------------------------------------;
; 选择通过点的对象 ;
; ;
;(feng-wlkx-pointtossget 点) ;
; 返回选集 ;
;-------------------------------------------------------;
(defun feng-wlkx-pointtossget ( p / li )
(setq li (list
(list (- (car p) 1) (- (cadr p) 1) 0)
(list (- (car p) 1) (+ (cadr p) 1) 0)
(list (+ (car p) 1) (+ (cadr p) 1) 0)
(list (+ (car p) 1) (- (cadr p) 1) 0)
)
)
(ssget "cp" li '((0 . "LINE,ARC,CIRCLE")))
)
;-------------------------------------------------------;
; 创建外轮廓线 ;
; ;
;(feng-wlkx-makeplinelist 模型 ((节点 对象)...));
; ;
; 返回列表 ;
;-------------------------------------------------------;
(defun feng-wlkx-makeplinelist ( ms li / dt n dtli pli s1 p1 p2 sa )
(setq dtli '()
pli '()
n -1
li (feng-wlkx-makeplinelist-delete li)
li (REVERSE (cons (nth 0 li) (REVERSE li)))
)
(repeat (length li)
(setq p1 (car (nth (setq n (1+ n)) li))
s1 (cadr (nth n li))
)
(if (and (= (vla-get-ObjectName s1) "AcDbArc") (<= n (- (length li) 2)))
(setq p2 (car (nth (1+ n) li))
dtli (cons (list (feng-wlkx-arctocon s1 p1 p2) n) dtli)
)
)
(setq pli (append pli p1))
)
(setq s1 (vla-AddPolyline ms (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (- (length pli) 1))) pli)))
(repeat (setq n (length dtli))
(vla-SetBulge s1 (cadr (nth (setq n (1- n)) dtli)) (car (nth n dtli)))
)
)
(defun feng-wlkx-makeplinelist-delete ( li / n nn li1 li2 tt n1 n2 )
(setq li2 li
li1 '()
)
(while (/= li1 li2)
(setq n 0)
(while (<= n (- (length li2) 1))
(if (or (= n (- (length li2) 1)) (= n 0))
(setq li1 (append li1 (list (nth n li2)))
n (1+ n)
)
(if (> (DISTANCE (car (nth (1- n) li2)) (car (nth (1+ n) li2))) 1)
(setq li1 (append li1 (list (nth n li2)))
n (1+ n)
)
(setq n (+ n 2))
)
)
)
(repeat (setq n1 (length li1))
(setq n1 (1- n1))
(repeat (setq n2 n1)
(if (and (null tt) (<= (DISTANCE (car (nth n1 li1)) (car (nth (setq n2 (1- n2)) li1))) 1e-5))
(setq tt t)
)
)
)
(if tt
(setq li2 li1
li1 '()
tt nil
)
(setq li2 li1)
)
)
li1
)
;-------------------------------------------------------;
; 计算选集与指定对象的交点 ;
; ;
;(feng-wlkx-ssgettointer 指定对象 选集 当点前);
; ;
; 返回交点列表 ;
;-------------------------------------------------------;
(defun feng-wlkx-ssgettointer ( s1 ss p / s2 n nn inp li )
(setq li '())
(repeat (setq n (sslength ss))
(setq s2 (vlax-ename->vla-object (ssname ss (setq n (1- n))))
inp (vlax-variant-value (vla-IntersectWith s1 s2 acExtendNone))
)
(if (> (vlax-safearray-get-u-bound inp 1) 0)
(repeat (/ (setq nn (length (setq inp (vlax-safearray->list inp)))) 3)
(setq li (cons (list (list (nth (setq nn (- nn 3)) inp) (nth (+ nn 1) inp) (nth (+ nn 2) inp)) s1) li))
)
)
)
(princ "\n-------(feng-wlkx-ssgettointer)---------\n")
(princ "\n-------------li-------------------------\n")
(princ li)
(princ "\n----------------------------------------\n")
(VL-SORT li '(LAMBDA (x y) (<= (DISTANCE p (car x)) (DISTANCE p (car y)))))
)
;-------------------------------------------------------;
; 选择通过对象的对象 ;
; ;
;(feng-wlkx-sstossget 基准对象 前一个节点 当前节点);
; ;
; 返回(选集 逆时针端点) ;
;-------------------------------------------------------;
(defun feng-wlkx-sstossget ( s1 p p0 / p1 p2 p3 p4 param1 param2 pmin pmax n na ss )
(setq p1 (vlax-curve-getStartPoint s1)
p2 (vlax-curve-getEndPoint s1)
param1 (vlax-curve-getParamAtPoint s1 p0)
)
(if (<= (feng-3pointtoangle p p0 p1) (feng-3pointtoangle p p0 p2))
(setq param2 (vlax-curve-getStartParam s1)
p4 p1
)
(setq param2 (vlax-curve-getEndParam s1)
p4 p2
)
)
(setq p3 (vlax-curve-getPointAtParam s1 (/ (+ param1 param2) 2))
ss (ssget "f" (feng-3pointtosetnewxybox p0 p4 p3) '((0 . "LINE,ARC,CIRCLE")))
)
(repeat (setq n (sslength ss))
(if (= (vla-get-Handle (vlax-ename->vla-object (setq na (ssname ss (setq n (1- n)))))) (vla-get-Handle s1))
(setq ss (ssdel na ss))
)
)
(list ss p4)
)
;-------------------------------------------------------;
; 根据对象对外包框进行转换旋转 ;
; ;
;(feng-3pointtosetnewxybox 原点 旋转点 目标点);
; ;
; 外包框向外扩一个单元 ;
; ;
; 返回外包框列表(p1 p2 p3 p4) ;
;-------------------------------------------------------;
(defun feng-3pointtosetnewxybox ( p p2 p3 / p1 ang n li li1 xmin xmax ymin ymax )
(setq ang (angle p p2)
p2 (feng-xytomyxy p2 ang p)
p3 (feng-xytomyxy p3 ang p)
xmin (+ (min 0 (car p2) (car p3)) 2)
xmax (+ (max 0 (car p2) (car p3)) 1)
ymin (- (min 0 (cadr p2) (cadr p3)) 1)
ymax (+ (max 0 (cadr p2) (cadr p3)) 1)
li (list
(list xmin ymin 0)
(list xmin ymax 0)
(list xmax ymax 0)
(list xmax ymin 0)
)
li1 '()
)
(FOREACH n li (setq li1 (append li1 (list (feng-myxytoxy p ang n)))))
li1
)
;-------------------------------------------------------;
; 求以p2为角点，p1到p3的逆时针弧度 ;
; ;
;(feng-3pointtoangle 开始点 角点 终止点) ;
; ;
;参考求３点逆时针角度.----by lxx.2007.2 ;
; ;
; 返回逆时针弧度 ;
;-------------------------------------------------------;
(defun feng-3pointtoangle ( p1 p2 p3 / ang li tmin tmax )
(setq li (list (angle p1 p2) (angle p3 p2))
tmin (apply 'min li)
tmax (apply 'max li)
ang (- tmax tmin)
)
(if (or (<= ang 1e-5) (<= (DISTANCE p1 p2) 1e-5) (<= (DISTANCE p3 p2) 1e-5))
(* 2 pi)
(if (= tmin (car li))
ang
(- (* 2 pi) ang)
)
)
)
;-------------------------------------------------------;
; 坐标系转换 ;
; ;
;(feng-xytomyxy 目标点 夹角 坐标系原点) ;
; ;
;(feng-myxytoxy 目标点 夹角 坐标系原点) ;
; ;
; 返回计算后的坐标点 ;
;-------------------------------------------------------;
;-------------------------------------------------------;
; 标准坐标系===》》自定义坐标系 ;
;-------------------------------------------------------;
(defun feng-xytomyxy ( p ang p0 / x y )
(setq x (+ (* (cos ang) (- (car p) (car p0))) (* (sin ang) (- (cadr p) (cadr p0)))))
(setq y (- (* (cos ang) (- (cadr p) (cadr p0))) (* (sin ang) (- (car p) (car p0)))))
(list x y 0)
)
;-------------------------------------------------------;
; 自定义坐标系==》》标准坐标系 ;
;-------------------------------------------------------;
(defun feng-myxytoxy ( p ang p0 / x y )
(setq x (+ (- (* (car p0) (cos ang)) (* (cadr p0) (sin ang))) (car p)))
(setq y (+ (* (car p0) (sin ang)) (* (cadr p0) (cos ang)) (cadr p)))
(list x y 0)
)
;-------------------------------------------------------;
; 通过弧线计算凸度 ;
; ;
;(feng-wlkx-arctocon s1 p1 p2) ;
; ;
; 返回凸度 ;
;-------------------------------------------------------;
(defun feng-wlkx-arctocon ( s1 p1 p2 / p3 ang td )
(setq p3 (vlax-curve-getPointAtParam s1 (/ (+ (vlax-curve-getParamAtPoint s1 p1) (vlax-curve-getParamAtPoint s1 p2)) 2))
ang (angle p1 p2)
p2 (feng-xytomyxy p2 ang p1)
p3 (feng-xytomyxy p3 ang p1)
td (- (/ (* 2 (cadr p3)) (car p2)))
)
td
) 2012
好像运行不起来
命令:ASDF
-------pointtossget-------
nil--->>>
然后就结束了 论坛有highflybird大师的帖子哦
一个高效率的凸包算法！
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=56069&fromuid=398403 命令: asdf
-------pointtossget-------
nil--->>>; 错误: 参数类型错误: lselsetp nil
网上有这方面的程序
里面我没有加上对块和多段线的临时分解，呵。测试的时候，我只画了几条线，好像还不会出现这么惨的后果。一忙，都不知道编到哪了，呵。 扩展一下 凸包算法，网上找到
http://wenku.baidu.com/view/46808150ad02de80d4d840cf.html 外轮廓线和凸包不一样吧，外轮廓线可能是凹的
页:
[1]