马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
下面代码求指定点附近的LOOP的父亲(PARENTLOOP)和当前的祖宗(ROOTLOOP)
上面演示的图片,上下是一个单独的填充,有两个外部环(ROOT),我们的代码
1、拾取点
2、该点附近的LOOP品红色显示,父亲黄色显示,直系的祖宗(ROOT)红色显示(该图片祖宗有两个分支)
- (defun c:tt ()
- (if (and (setq e (xdrx_entsel "\n拾取填充<退出>:" '((0 . "HATCH"))))
- (xdrx_pickset_redraw e)
- (setq p (getpoint "\n在填充环附近点一点<退出>:"))
- )
- (progn
- (xdrx_begin)
- (setq mp (xdrx_hatch->mpolygon e)
- mp (entlast)
- )
- (if (and (setq closestLoop
- (xdrx_getpropertyvalue mp "ClosestLoopTo" p)
- )
- (setq parentloop
- (xdrx_getpropertyvalue
- mp
- "parentloop"
- closestloop
- )
- )
- (setq roots
- (xdrx_getpropertyvalue
- mp
- "rootloops"
- closestloop
- )
- )
- )
- (progn
- (setq loopdata (xdrx_getpropertyvalue
- mp
- "MPolygonLoopAt"
- closestloop
- )
- )
- (xdrx_polyline_make loopdata)
- (xdrx_setpropertyvalue
- (entlast)
- "constantwidth"
- 20.0
- "color"
- 6
- )
- (setq parentdata
- (xdrx_getpropertyvalue
- mp
- "MPolygonLoopAt"
- parentloop
- )
- )
- (xdrx_polyline_make parentdata)
- (xdrx_setpropertyvalue
- (entlast)
- "constantwidth"
- 20.0
- "color"
- 2
- )
- (if (> (length roots) 1)
- (progn
- (vl-some
- '(lambda (x)
- (setq
- child (xdrx_getpropertyvalue mp "childloops" x)
- )
- (if (member closestloop child)
- (setq rootloop x)
- )
- )
- roots
- )
- )
- (setq rootloop (car roots))
- )
- (setq rootdata
- (xdrx_getpropertyvalue
- mp
- "MPolygonLoopAt"
- rootloop
- )
- )
- (xdrx_polyline_make rootdata)
- (xdrx_setpropertyvalue
- (entlast)
- "constantwidth"
- 20.0
- "color"
- 1
- )
- )
- )
- (xdrx_entity_delete mp)
- (xdrx_pickset_redraw e t)
- (xdrx_end)
- )
- )
- (princ)
- )
|