创建外轮廓线（非面域方式）

feng582304 · 发表于 2011-11-15 14:11:13

本帖最后由 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
)

;-------------------------------------------------------------------------------; 
;    总执行函数              ; 
;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 
  )

xotoo · 发表于 2011-11-15 17:50:19

2012
好像运行不起来

命令: ASDF
-------pointtossget-------
nil--->>>

然后就结束了

vormittag · 发表于 2011-11-15 18:20:34

论坛有highflybird大师的帖子哦
一个高效率的凸包算法！
http://bbs.mjtd.com/forum.php?mo ... &fromuid=398403

461045462 · 发表于 2011-11-15 18:26:04

命令: asdf
-------pointtossget-------
nil--->>>; 错误: 参数类型错误: lselsetp nil
网上有这方面的程序

feng582304 · 发表于 2011-11-16 14:35:17

里面我没有加上对块和多段线的临时分解，呵。测试的时候，我只画了几条线，好像还不会出现这么惨的后果。一忙，都不知道编到哪了，呵。

skg123 · 发表于 2012-4-12 22:25:23

扩展一下凸包算法，网上找到
http://wenku.baidu.com/view/46808150ad02de80d4d840cf.html

lameduck · 发表于 2015-6-2 19:36:07

外轮廓线和凸包不一样吧，外轮廓线可能是凹的

账号		自动登录	找回密码
密码			注册

创建外轮廓线（非面域方式）

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块