;;;将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)
) 能不能改一下使块自动随曲线方向旋转？？？ 本帖最后由 victo_ept 于 2013-7-22 23:33 编辑
bai2000 发表于 2013-7-22 21:20 http://bbs.mjtd.com/static/image/common/back.gif
能不能改一下使块自动随曲线方向旋转？？？
程序还有点缺陷，块旋转角度只处理为-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)
)
终于出现大侠了，马上试用 本帖最后由 自贡黄明儒 于 2013-7-23 12:52 编辑
我的这个，你可以参考一下，原来我也只是块
http://bbs.mjtd.com/thread-101674-1-1.html
我写的me
http://bbs.mjtd.com/thread-101300-1-1.html 自贡黄明儒 发表于 2013-7-23 12:50 static/image/common/back.gif
我的这个，你可以参考一下，原来我也只是块
http://bbs.mjtd.com/thread-101674-1-1.html
感谢，超级me无法加载，提示例表有缺陷，能检查一下吗?
fan_zh 发表于 2013-7-23 14:49 static/image/common/back.gif
感谢，超级me无法加载，提示例表有缺陷，能检查一下吗?
改后还是不行啊
能找下原因吗，
见附件 能不能改下：满足求：http://bbs.mjtd.com/thread-101459-1-1.html 的要求？
页:
1
[2]