flytoday 发表于 2011-12-7 19:49:51

顶上~~~~~~~~~~~

123456abc 发表于 2012-3-1 20:35:13

强烈要求加上框选功能,另外去掉中心线图层行吗?

daiguafan 发表于 2012-3-1 20:56:28

厉害,厉害。哈哈

vlisp2012 发表于 2012-3-1 22:08:07

cad2011win7 矩形的中心线不能加:selection a object!; 错误: 参数类型错误: 二维/三维点: 0.0

123456abc 发表于 2012-3-2 22:02:47

呼唤高手出来看看啊

h008 发表于 2012-3-7 15:39:39

不用这么复杂,利用vla-GetBoundingBox 取得对象外框就好办了,不用区别图元类型

669423907 发表于 2012-3-7 15:57:27

h008 发表于 2012-3-7 15:39 static/image/common/back.gif
不用这么复杂,利用vla-GetBoundingBox 取得对象外框就好办了,不用区别图元类型

h008 大师整个看看..........

cyfdean 发表于 2012-3-7 17:22:54

回来支持,请楼主修改,完善,期待中。。。。。。

puzb2001 发表于 2012-3-7 17:37:29

这个必须顶!表示强烈支持!

h008 发表于 2012-3-8 09:32:31

669423907 发表于 2012-3-7 15:57 static/image/common/back.gif
h008 大师整个看看..........

我试试,我是菜鸟,写的代码不够漂亮!

(defun 2d_mid (pt1 pt2);求两点中点 这就是函数应该是来自是明经的
(mapcar
    '(lambda (x y)
       (/ (+ x y) 2.0)
   )
    pt1
    pt2
)
)
;;;;;;;;;;;;;;;;;;;;

(defun c:zxx( / ccbs entname list1 list2 bkd bgd cen_po cen_s cen_x cen_z cen_y);中心线
;(szkt)设置开头
(command "_layer" "m" "中心线" "C" 6 "" "L" "ACAD_ISO10W100" "" "")
(setq ccbs 1.5);自设个超出倍数 必须大于1
(while (setq entname (car(entsel)))
(vl-load-com)
(vla-GetBoundingBox (vlax-ename->vla-object entname) 'list1 'list2)
(setq list1 (vlax-safearray->list list1))
(setq list2 (vlax-safearray->list list2))

(setq
bkd (* (- (car list2) (car list1)) ccbs 0.5);半宽度
bgd (* (- (cadr list2) (cadr list1)) ccbs 0.5);半高度
cen_po (2d_mid list2 list1)
cen_s (list (car cen_po) (+ (cadr cen_po) bgd))
cen_x (list (car cen_po) (- (cadr cen_po) bgd))
cen_z (list (- (car cen_po) bkd) (cadr cen_po))
cen_y (list (+ (car cen_po) bkd) (cadr cen_po))
)

;(command "rectang" list1 list2)
(command "line" cen_s cen_x "")
(command "line" cen_z cen_y "")

);while
;(szjs)设置结束
);;中心线
页: 1 2 [3] 4 5 6
查看完整版本: 我写的加中心线的程序,可以加矩形、圆、平行线的