批量交点插入块

fkyourmather

批量交点插入块
求思路，最好是贴出，此东东是开心大师的，希望他能够分享一下

crywen

这个插件不错…………

ScmTools

先获取一个交点表，然后遍历点表插入块就好了

fkyourmather

ScmTools 发表于 2013-5-1 11:03
先获取一个交点表，然后遍历点表插入块就好了

可以私下发个吗～但是矩形是中心插入交点,交点 表我倒是有可是插入块 就没有见过了

牢固

[pcode=lisp,true];;框选范围内交点插入图块  By Gu_xl 2011.04
;;;计算曲线交点
(defun Curveinters (en1 en2 / pl pts)
  (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
  (while pl
    (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
   pl (cdr (cdr (cdr pl)))
   )
    )
pts
  )
;;;曲线选择集交点
(defun ssinters (ss / pts en1 en2)
  (while (> (sslength ss) 1)
    (setq en1 (ssname ss 0))
    (ssdel en1 ss)
    (setq n (sslength ss))
    (repeat n
      (setq en2 (ssname ss (setq n (1- n))))
      (setq pts (append pts (Curveinters en1 en2)))
      )
    )
  pts
  )


;;;实例: 按选择范围框内插入图块
(defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho blockname )
  (setq os (getvar "osmode"))
  (setq cmdecho (getvar "cmdecho"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setq blockname (getstring  "\n插入块名称:"))
  (if (null d) (setq d 1.))
  (while (and
           (setq p1 (getpoint "\n选择插入范围左下角："))
           (setq p2 (GETCORNER p1 "\n选择插入范围左下角："))
           )
    (setq minX (apply 'min (mapcar 'car (list p1 p2)))
          minY (apply 'min (mapcar 'cadr (list p1 p2)))
          maxX (apply 'max (mapcar 'car (list p1 p2)))
          maxY (apply 'max (mapcar 'cadr (list p1 p2)))
          )
    (grvecs (list 1 (list minx miny) (list maxx miny)
                  1 (list maxx miny) (list maxx maxy)
                  1 (list maxx maxy) (list minx maxy)
                  1 (list minx maxy) (list minx miny)
                  )
            )
    (setq ss (ssget "c" p1 p2 '((0 . "*line"))))
    (if ss
      (progn
        (setq pts (ssinters ss))
        (if pts
          (foreach pt pts
            (if (and (>= maxX (car pt) minX)
                     (>= maxY (cadr pt) minY)
                     )
              ;;插入图块
              (command "insert" blockname "_non" pt 1 1 0)
              )
            )
          )
        )
      )
    (princ "\n ***回车键结束***")
    )
(setvar "osmode" os)
  (setvar "cmdecho" cmdecho)
  (princ)
  )
[/pcode]

fkyourmather

牢固 发表于 2013-5-1 21:24
;;框选范围内交点插入图块  By Gu_xl 2011.04
;;;计算曲线交点
(defun Curveinters (en1 en2 / pl pts)

如何完成这个交点插入块，此程序无法完成

aihua007

不行啊，怎么整的，有高手指点下不

yuanziyou

如果坐标特别大，比如x坐标有8位时，这样计算交点会出错，没有交点也会计算出交点，解决方法是把对象移动到0 0 0后重新计算

qxlonmsn

牢固 发表于 2013-5-1 21:24
;;框选范围内交点插入图块  By Gu_xl 2011.04
;;;计算曲线交点
(defun Curveinters (en1 en2 / pl pts)

大神   你好厉害

qxlonmsn

牢固 发表于 2013-5-1 21:24
;;框选范围内交点插入图块  By Gu_xl 2011.04
;;;计算曲线交点
(defun Curveinters (en1 en2 / pl pts)

我在其他地方也找到过代码   贴出来大家讨论一下
(defun c:getint( / ent1 ent2 ps)
(vl-load-com)
(setq ent1 (car (entsel "\n选择第一实体:")))
(setq ent2 (car (entsel "\n选择第二实体:")))
(print)
(setq ps (obj_int ent1 ent2))
)
;功能:返回两个对象的所有交点
;参数: ent1、ent2 均为ename对象
(defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
(setq ax_ent_1 (vlax-ename->vla-object ent1)
         ax_ent_2 (vlax-ename->vla-object ent2)
)
;;ExtendBoth  两个实体都延伸
;;ExtendArgument  只延伸作为参数的实体(该方法的第一个参数)
;;ExtendThis  只延伸原实体(调用该方法的实体)
;;OnBothOperands  两个实体都不延伸
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
;;数组的值
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
;;如果有交点
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
    (repeat (/ (+ 1
                (- (vlax-safearray-get-u-bound intpoints 1)
                   (vlax-safearray-get-l-bound intpoints 1)
                )   
                   )
                3
                )
(setq points (append points (list (list
(vlax-safearray-get-element intpoints i)
(vlax-safearray-get-element intpoints (+ i 1))
(vlax-safearray-get-element intpoints (+ i 2))
)));;end append
);end setq
(setq i (+ 3 i))
);end repeat
);end if

points
)

hh_lj007

感谢大家分享源码

luoyusen

非常好，谢谢楼主，下载看看