交点排序准确标注

lzgxklable · 发表于 2011-9-1 21:52:47

vl-load-com)
(princ "选择辅助线\n")
(setq m_ent1 (car(entsel)))
(setq ent1_s(vlax-curve-getStartPoint p1))
(print "请选择需要扫描的区域：")
(setq ss (ssget))
(setq lengss (sslength ss))
(setq bb 0)
(while (< bb lengss)
(setq p1 (ssname ss bb))
(setq ed (entget p1))
下面不知道该如何写了
即把ss选择集的每条曲线按照到某点(该点不在ss内的任何一条曲线上)的距离有小到大重新排序，为了实现交点的顺序排列，以便进行准确标注，见附图

望各位高手指教,谢谢

longer1000 · 发表于 2011-9-2 08:48:50

顶下，期待中

xyp1964 · 发表于 2011-9-2 12:53:37

;; 交点排序标注
;; 需要e派工具箱(XCAD)的支持：[url=http://xyp1964.ys168.com]http://xyp1964.ys168.com[/url]
(defun c:tt ()
(CMDLA0)
(if (and (setq s1 (car (entsel "\n选择: ")))
(xyp-curve-check s1)
(setq ptn (xyp-Get-CurveIntersLeng s1 3))
)
(progn
(setq ptn (xyp-Curve-PtsLengSort s1 ptn nil)
i 1
)
(foreach pt ptn
(xyp-Cross pt 100 0)
(xyp-Text 5 pt (itoa i))
(setq i (1+ i))
)
)
)
(CMDLA1)
)

gbhsu · 发表于 2011-9-2 20:24:09

呵呵
院长炫的
什么问题也不解决

xyp1964 · 发表于 2011-9-3 00:45:27

gbhsu 发表于 2011-9-2 20:24
呵呵
院长炫的
什么问题也不解决

有演示、有代码，还要啥？

gbhsu · 发表于 2011-9-3 07:12:09

呵呵
大家去下载ei派工具箱呀
里面有非常多的东东哦
免费的呀

byghbcx · 发表于 2011-9-3 11:56:50

(setq pts (vl-sort pts '(lambda (s1 s2) (< (vlax-curve-getDistAtPoint (vlax-ename->vla-object m_ent1) s1)
(vlax-curve-getDistAtPoint (vlax-ename->vla-object m_ent1) s2)))
))

byghbcx · 发表于 2011-9-3 11:57:30

(defun tt ()
  (vl-load-com)
  (defun GETINTERS
   (FSTENT NXTENT XMODE / INTPNT PNTLST TMPLST TMPPNT)
(cond
   ((and FSTENT NXTENT)
   (setq INTPNT (vla-intersectwith
      (vlax-ename->vla-object FSTENT)
      (vlax-ename->vla-object NXTENT)
      XMODE
      )
      TMPPNT (vlax-variant-value INTPNT)
      )
   (cond
   ((safearray-value TMPPNT)
   (setq TMPLST (vlax-safearray->list TMPPNT))
   (repeat (/ (length TMPLST) 3)
      (setq PNTLST
   (cons
   (list
      (car TMPLST)
      (cadr TMPLST)
      (caddr TMPLST)
      )
   PNTLST
   )
   TMPLST (cdddr TMPLST)
   )
      )
   (reverse PNTLST)
   )
   (t NIL)
   )
   )
   (t NIL)
   )
)
  (princ "选择辅助线\n")
  (setq m_ent1 (car (entsel)))
  (print "请选择需要扫描的区域：")
  (setq ss (ssget) ss1 (ssadd))
  (setq lengss (sslength ss))
  (setq bb 0)
  (while (< bb lengss)
(setq p1 (ssname ss bb))
(setq ed (entget p1))
(setq m_jdtab14 (vla-intersectwith
      (vlax-ename->vla-object p1)
      (vlax-ename->vla-object m_ent1)
      0
      )
)
(setq pts1 (vlax-variant-value m_jdtab14))
(if (> (vlax-safearray-get-u-bound pts1 1) 0)
   (ssadd p1 ss1)
)
(setq bb (+ bb 1))
  )
  (setq lengss (sslength ss1))
  (setq bb 0 pts '())
  (while (< bb lengss)
(setq p11 (ssname ss1 bb))
(setq p14 (getinters m_ent1  p11 0))
;(setq p14 (vlax-safearray->list (vlax-variant-value m_jdtab14)))
(setq pts (append p14 pts))
(command "circle" p14 50 )
(setq bb (+ bb 1))
  )
  ;(setq pt0 (vlax-curve-getStartPoint (vlax-ename->vla-object m_ent1)))
  (setq pts (vl-sort pts '(lambda (s1 s2) (< (vlax-curve-getDistAtPoint (vlax-ename->vla-object m_ent1) s1)
   (vlax-curve-getDistAtPoint (vlax-ename->vla-object m_ent1) s2)))
   ))
  (setq bb 0)
  (repeat (1- (length pts)) (command "_dimaligned" (nth bb pts) (nth (1+ bb) pts) (nth (1+ bb) pts))
(setq bb (+ bb 1))
)
)

lzgxklable · 发表于 2011-9-3 12:54:18

谢谢高手们

mac · 发表于 2011-9-3 15:16:46

程序不错!

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

交点排序准确标注

本帖子中包含更多资源

本帖子中包含更多资源