如何按按指定距离条件在线上批量布置图块

victo_ept · 发表于 2013-7-22 19:28:11

;;;可处理线段、弧、多段线、样条曲线
;;;将blockname替换为图块名
(vl-load-com)
(defun C:aaa ()
(setq cmdbak (getvar "cmdecho"))
(setvar "cmdecho" 0)
(initget 7)
(setq len1 (getreal "\n输入端距： ")
)
(initget 7)
(setq len2 (getreal "\n输入最大间距："))
(setq ss nil)
(while (not ss)
(princ "\n选择曲线（线段/圆弧/多段线/样条曲线）：")
(setq ss (ssget '((-4 . "<OR")
(0 . "LINE")
(0 . "ARC")
(0 . "LWPOLYLINE")
(0 . "POLYLINE")
(0 . "SPLINE")
(-4 . "OR>")
)
)
)
)
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(setq obj_len (vlax-curve-getDistAtPoint
obj
(vlax-curve-getEndPoint obj)
)
)
(if (> (setq eff_len (- obj_len (* 2 len1))))
(progn
;;; (setq eff_len (/ (fix (* eff_len 10000)) 10000)) ;如有误差，可使用此处消除误差
(setq n (1+ (fix (/ eff_len len2))))
(setq len len1)
(setq dlt (/ eff_len n))
(repeat (1+ n)
(setq pnt (vlax-curve-getPointAtDist obj len))
(entmake (list '(0 . "insert")
(cons 10 pnt)
(cons 2 "blockname")
)
)
(setq len (+ len dlt))
)
)
)
(setq i (1+ i))
)
(setvar "cmdecho" cmdbak)
(princ)
)

;;;可处理线段、弧、多段线、样条曲线 
;;;将blockname替换为图块名 
 
 
(vl-load-com) 
(defun C:aaa () 
  (setq cmdbak (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
   
  (initget 7) 
  (setq len1 (getreal "\n输入端距： ") 
        ) 
  (initget 7) 
  (setq len2 (getreal "\n输入最大间距：")) 
   
  (setq ss nil) 
  (while (not ss) 
    (princ "\n选择曲线（线段/圆弧/多段线/样条曲线）：") 
    (setq ss (ssget '((-4 . "<OR") 
                      (0 . "LINE") 
                      (0 . "ARC") 
                      (0 . "LWPOLYLINE") 
                      (0 . "POLYLINE") 
                      (0 . "SPLINE") 
                      (-4 . "OR>") 
                     ) 
             ) 
    ) 
  ) 
 
  (setq i 0) 
  (repeat (sslength ss) 
    (setq ent (ssname ss i)) 
    (setq obj (vlax-ename->vla-object ent)) 
    (setq obj_len (vlax-curve-getDistAtPoint 
                    obj 
                    (vlax-curve-getEndPoint obj) 
                  ) 
    ) 
    (if        (> (setq eff_len (- obj_len (* 2 len1)))) 
      (progn 
;;;        (setq eff_len (/ (fix (* eff_len 10000)) 10000))       ;如有误差，可使用此处消除误差 
        (setq n (1+ (fix (/ eff_len len2)))) 
        (setq len len1) 
        (setq dlt (/ eff_len n)) 
        (repeat        (1+ n) 
          (setq pnt (vlax-curve-getPointAtDist obj len)) 
          (entmake (list '(0 . "insert") 
                         (cons 10 pnt) 
                         (cons 2 "blockname") 
                   ) 
          ) 
          (setq len (+ len dlt)) 
        ) 
      ) 
    ) 
    (setq i (1+ i)) 
  ) 
  (setvar "cmdecho" cmdbak) 
  (princ) 
)

bai2000 · 发表于 2013-7-22 21:20:09

能不能改一下使块自动随曲线方向旋转？？？

victo_ept · 发表于 2013-7-22 23:26:28

本帖最后由 victo_ept 于 2013-7-22 23:33 编辑

bai2000 发表于 2013-7-22 21:20
能不能改一下使块自动随曲线方向旋转？？？

程序还有点缺陷，块旋转角度只处理为-90~90，对于其他角度，需要进一步选择及判断

;;;可处理线段、弧、多段线、样条曲线
;;;将blockname替换为图块名
(vl-load-com)
(defun C:aaa ()
(setq cmdbak (getvar "cmdecho"))
(setvar "cmdecho" 0)
(initget 7)
(setq len1 (getreal "\n输入端距： ")
)
(initget 7)
(setq len2 (getreal "\n输入最大间距："))
(setq ss nil)
(while (not ss)
(princ "\n选择曲线（线段/圆弧/多段线/样条曲线）：")
(setq ss (ssget '((-4 . "<OR")
(0 . "LINE")
(0 . "ARC")
(0 . "LWPOLYLINE")
(0 . "POLYLINE")
(0 . "SPLINE")
(-4 . "OR>")
)
)
)
)
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(setq obj_len (vlax-curve-getDistAtPoint
obj
(vlax-curve-getEndPoint obj)
)
)
(if (> (setq eff_len (- obj_len (* 2 len1))))
(progn
;;; (setq eff_len (/ (fix (* eff_len 10000)) 10000)) ;如有误差，可使用此处消除误差
(setq n (1+ (fix (/ eff_len len2))))
(setq len len1)
(setq dlt (/ eff_len n))
(repeat (1+ n)
(setq pnt (vlax-curve-getPointAtDist obj len))
(setq para (vlax-curve-getParamAtDist obj len))
(setq deriv (vlax-curve-getFirstDeriv obj para))
(if (zerop (car deriv))
(setq ang (/ pi 2))
(setq ang (atan (/ (cadr deriv) (car deriv))))
)
(entmake (list '(0 . "insert")
(cons 10 pnt)
(cons 2 "blockname")
(cons 50 ang)
)
)
(setq len (+ len dlt))
)
)
)
(setq i (1+ i))
)
(setvar "cmdecho" cmdbak)
(princ)
)

;;;可处理线段、弧、多段线、样条曲线 
;;;将blockname替换为图块名 
 
 
(vl-load-com) 
(defun C:aaa () 
  (setq cmdbak (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
 
  (initget 7) 
  (setq        len1 (getreal "\n输入端距： ") 
  ) 
  (initget 7) 
  (setq len2 (getreal "\n输入最大间距：")) 
 
  (setq ss nil) 
  (while (not ss) 
    (princ "\n选择曲线（线段/圆弧/多段线/样条曲线）：") 
    (setq ss (ssget '((-4 . "<OR") 
                      (0 . "LINE") 
                      (0 . "ARC") 
                      (0 . "LWPOLYLINE") 
                      (0 . "POLYLINE") 
                      (0 . "SPLINE") 
                      (-4 . "OR>") 
                     ) 
             ) 
    ) 
  ) 
 
  (setq i 0) 
  (repeat (sslength ss) 
    (setq ent (ssname ss i)) 
    (setq obj (vlax-ename->vla-object ent)) 
    (setq obj_len (vlax-curve-getDistAtPoint 
                    obj 
                    (vlax-curve-getEndPoint obj) 
                  ) 
    ) 
    (if        (> (setq eff_len (- obj_len (* 2 len1)))) 
      (progn 
;;;        (setq eff_len (/ (fix (* eff_len 10000)) 10000))       ;如有误差，可使用此处消除误差 
        (setq n (1+ (fix (/ eff_len len2)))) 
        (setq len len1) 
        (setq dlt (/ eff_len n)) 
        (repeat        (1+ n) 
          (setq pnt (vlax-curve-getPointAtDist obj len)) 
          (setq para (vlax-curve-getParamAtDist obj len)) 
          (setq deriv (vlax-curve-getFirstDeriv obj para)) 
          (if (zerop (car deriv)) 
            (setq ang (/ pi 2)) 
            (setq ang (atan (/ (cadr deriv) (car deriv)))) 
          ) 
          (entmake (list '(0 . "insert") 
                         (cons 10 pnt) 
                         (cons 2 "blockname") 
                         (cons 50 ang) 
                   ) 
          ) 
          (setq len (+ len dlt)) 
        ) 
      ) 
    ) 
    (setq i (1+ i)) 
  ) 
  (setvar "cmdecho" cmdbak) 
  (princ) 
)

fan_zh · 发表于 2013-7-23 08:59:19

终于出现大侠了，马上试用

自贡黄明儒 · 发表于 2013-7-23 12:50:28

本帖最后由自贡黄明儒于 2013-7-23 12:52 编辑

我的这个，你可以参考一下，原来我也只是块
http://bbs.mjtd.com/thread-101674-1-1.html

我写的me
http://bbs.mjtd.com/thread-101300-1-1.html

fan_zh · 发表于 2013-7-23 14:49:29

自贡黄明儒发表于 2013-7-23 12:50
我的这个，你可以参考一下，原来我也只是块
http://bbs.mjtd.com/thread-101674-1-1.html

感谢，超级me无法加载，提示例表有缺陷，能检查一下吗?

fan_zh · 发表于 2013-7-23 15:00:13

fan_zh 发表于 2013-7-23 14:49
感谢，超级me无法加载，提示例表有缺陷，能检查一下吗?

改后还是不行啊
能找下原因吗，

见附件

bai2000 · 发表于 2013-7-23 20:29:03

能不能改下：满足求：http://bbs.mjtd.com/thread-101459-1-1.html 的要求？

fan_zh · 发表于 2013-7-24 12:43:16

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

[讨论] 如何按按指定距离条件在线上批量布置图块

评分

点评

本帖子中包含更多资源