我写的加中心线的程序，可以加矩形、圆、平行线的

flytoday

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

123456abc

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

daiguafan

厉害，厉害。哈哈

vlisp2012

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

123456abc

呼唤高手出来看看啊

h008

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

669423907

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

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

cyfdean

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

puzb2001

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

h008

669423907 发表于 2012-3-7 15:57
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)设置结束
  );;中心线