434939575 发表于 2014-12-10 10:15:51

请教处理外边框问题

请教一个问题，如左边图，想要求出右边红色外框。请各位帮忙指点，思路或代码。谢谢！

自贡黄明儒 发表于 2014-12-10 11:47:12

1 先求出所以虚交点
2 用高飞的程序扫描，求出所有最外的点
3 找出最外交点的对象

434939575 发表于 2014-12-10 17:41:26

感谢大师再次光临！

wzg356 发表于 2014-12-10 23:43:20

本帖最后由 wzg356 于 2014-12-11 00:56 编辑

应该成了，经针对直线情况;;;直线的外边框
;;;by wzg356 20141210
(defun c:wk ( / enlst en ptlst tblst enlst1 i inters1 interslst en1 en2 pt11 pt12 pt21 pt22 pt)
(setq enlst (ss-ents(ssget '((0 . "LINE")))));直线的图元名表
(setq ptlst nil);安全起见，设空
(foreach en enlst
    (setq ptlst (cons (cdr(assoc 10 (entget en))) ptlst))
    (setq ptlst (cons (cdr(assoc 11 (entget en))) ptlst))
);所有线图元顶点表ptlst
(setq tblst(ZL-TB ptlst));凸包点表ptlst
(setq enlst1 nil)
(repeat (setq i (length enlst))
(setq en (nth (- i 1) enlst))
    (if (and
      (member (cdr(assoc 10 (entget en))) tblst)
      (member (cdr(assoc 11 (entget en))) tblst)
      )
      (setq enlst1 (cons en enlst1))      
    )
    (setq i (- i 1))
);得到在凸包线上的图元名表enlst1
(setq interslst nil)
(setq i 1)
(while (and (setq en1 (car enlst1))(setq en2 (cadr enlst1)))
(setq pt11 (cdr(assoc 10 (entget en1))))
(setq pt12 (cdr(assoc 11 (entget en1))))
(setq pt21 (cdr(assoc 10 (entget en2))))
(setq pt22 (cdr(assoc 11 (entget en2))))
(if (= i 1);第一次循环计算第一边与最后一边交点
    (progn
      (setq pt31 (cdr(assoc 10 (entget (last enlst1)))))
      (setq pt32 (cdr(assoc 11 (entget (last enlst1)))))
      (if (setq inters1(inters pt11 pt12 pt31 pt32 nil));虚拟交点
      (setq interslst(cons inters1 interslst))
      )
    )
)
(if (setq inters1(inters pt11 pt12 pt21 pt22 nil));与下一边的虚拟交点
    (setq interslst (cons inters1 interslst));虚拟交点表
)
(setq enlst1(cdr enlst1))
(setq i (+ i 1))
)
(cond
((> (length interslst )2);;画外框
    (command "pline" (foreach pt interslst (command "non" pt)))
    (command "PEDIT" (entlast) "c" "")
    (command "chprop" (entlast) "" "c" "1" "")
    (princ "外框绘制成功！")   
)
((> (length tblst )2);只画凸包
    (command "pline" (foreach pt tblst (command "non" pt)));凸包
    (command "PEDIT" (entlast) "c" "")
    (command "chprop" (entlast) "" "c" "1" "")
    (princ "凸包绘制成功！")   
)
(T(princ "你选的对象无法画外包框！"))
)
)

;;;======================
;;;以下为两个通用函数

;选择集到图元列表 by 明经论坛
(defun ss-ents(ss / i en ents)
   (setq i 0)
   (repeat (sslength ss)
      (setq en (ssname ss i)
                  ents (cons en ents)
                  i (1+ i)
      )
    )
   ents
)

;;;      凸包分析
;;;from zml184的搜狐博客
;;;功能：得到包围点表的凸多边形顶点列表
;;;参数：lst_pt ----二维点表
;;;返回：包围这些点的凸多边形顶点列表（逆时针）
(defun ZL-TB (LST_PT / ZL-TB-001 PT0 ANG LST_JG PT)
    ;;=======================
    ;;功能：找出pt0的下一点
    ;;全局变量 lst_pt ----点表，
    ;;         ang    ----当前的方位角
    (defun ZL-TB-01 (LST PT / LST_TMP N ANGI DIST E1 E2)
(setq LST (vl-remove PT LST_PT))
;;从当前点出发找余下点表中方位角
(setq LST_TMP '())
;;计算方位角
(foreach N LST
      (setq ANGI (angle PT N)
      DIST (distance PT N)
      )
      (if(< ANGI ANG)
    ()
    (setq LST_TMP (cons (list N ANGI DIST) LST_TMP))
      )
)
;;根据方位角排序(若方位角相等，则区距离远的)
(setq LST_TMP (vl-sort LST_TMP
             '(lambda(E1 E2)
            (or(< (cadr E1) (cadr E2)) ;_先比较方位角
          (and (= (cadr E1) (cadr E2))
               (> (caddr E1) (caddr E2))
          )
            )
      )
          )
)
;;返回
(caar LST_TMP)
    )
    ;;=======================
    ;;先找Y坐标最小的点
    (setq LST_PT (vl-sort LST_PT
      '(lambda (E1 E2)
             (< (cadr E1) (cadr E2))
         )
   )
    )

    (setq PT0   (car LST_PT) ;_起点
    LST_JG (list PT0)
    ANG   0.0
    )
    ;;直到回到起点
    (while
(progn
      (setq PT (ZL-TB-01 LST_PT (car LST_JG))) ;_计算下一点
      (if(equal PT PT0) ;_判断是否回到起点
    NIL
    (setq ANG    (angle (car LST_JG) PT)
          LST_JG (cons PT LST_JG)
    )
      )
)
    )
    ;;返回
    (reverse LST_JG)
)
(princ)

434939575 发表于 2014-12-11 09:11:33

wzg356 发表于 2014-12-10 23:43 static/image/common/back.gif
应该成了，经针对直线情况

感谢这位朋友，都这么晚了，还百忙中抽空写代码。乃冬日里的阳光。！
页: [1]
查看完整版本: 请教处理外边框问题