自动连上
各位大虾,我想把圆灯缩小一半后灯两边的连线还是连上的,但每个灯的位还不能变动它,有没有更块的办法.烟为以前酒詀的灯做大了
现在又想改小,所以要缩小
本帖最后由 Andyhon 于 2012-8-7 17:44 编辑
(Defun Cp2txt_Aux (ent pto)
(command "Scale" ent "" pto fac)
(command "change" (mapcar '- pto xx) "" (mapcar '- pto dda))
(command "change" (mapcar '+ pto xx) "" (mapcar '+ pto dda))
)
;;; For test only
(Defun C:Cp2txt ()
(setq ss (ssget '((2 . "ltg"))))
(setq fac (getreal "\n 比率: ")) ; say 0.5
(setq i 0)
(setq ee (ssname ss i)
pts (acet-ent-geomextents ee) ; acet-ent-geomextents / Required ET
xx (- (caadr pts) (caar pts))
dd (* xx (- 1 fac) 0.5)
dda (list dd 0)
xx (list (* xx 0.5) 0)
)
(while (setq ee (ssname ss i))
(Cp2txt_Aux ee (apply 'mid_pt pts)) ; mid_pt 站内搜
(setq i (1+ i))
(and
(setq ee (ssname ss i))
(setq pts (acet-ent-geomextents ee))
) )
)
快捷键是什么呀,没反应呢 缺少函数吧:acet-ent-geomextents 需要安装ET ; 错误: *error* 函数中出错函数被取消
不像四楼所说的那样
但出现了新的问题
(defun ss2lst (ss / n e lst)
(repeat (setq n(sslength ss))
(setq lst (cons (ssname ss (setq n (1- n))) lst))
)
lst
)
(defun wbk(e / L_djx lst)
(vla-getboundingbox (vlax-ename->vla-object e) 'minp 'maxp)
(setq minp (reverse(cdr(reverse(vlax-safearray->list minp))))
maxp (reverse(cdr(reverse(vlax-safearray->list maxp))))
xminymaxp(list(car minp)(cadr maxp))
xmaxyminp(list(car maxp)(cadr minp))
lst(list minp xmaxyminp maxp xminymaxp minp)
)
(entmake (append(list'(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
(cons 90 (length lst)))(mapcar '(lambda (pt)(cons 10 pt)) lst ))
)
(setq ple(entlast))
(ssadd ple pless)
(setq L_djx(distance minp maxp)
midp (polar minp (angle minp maxp)(/ L_djx 2))
)
)
(defun c:sfbb(/ kname scnum ss pless liness linelst insertss
insertlst n inserte n cp1 cp2 midp clst elst ple
minp xmaxyminp maxp xminymaxp midp ple)
(command "undo" "be")
(setvar 'cmdecho 0)
(if (setq insertss (ssget'((0 . "insert")(2 . "ltg"))))
(progn
(setq pless(ssadd))
(setq pick(getvar 'pickbox))
(setq scnum(getreal"\n请输入缩放比例<0.5>"))
(if(not scnum)(setq scnum 0.5))
(repeat (setq n(sslength insertss))
(vla-getboundingbox (vlax-ename->vla-object
(setq inserte(ssname insertss (setq n(1- n))))) 'minp 'maxp)
(setq cp1 (mapcar '(lambda(x)(- x pick))(vlax-safearray->list minp))
cp2 (mapcar '(lambda(x)(+ x pick))(vlax-safearray->list maxp))
midp (polar cp1 (angle cp1 cp2)(/ (distance cp1 cp2) 2))
)
(ssget "c" cp1 cp2)
(setq clst(cons(cons inserte (ss2lst(ssget "p" '((0 . "line")))))clst))
(command "scale" inserte "" midp scnum)
)
(repeat (setq n(length clst))
(setq elst(nth (setq n(1- n)) clst))
(wbk (car elst))
(command "zoom" "o" ple "")
(foreach x (cdr elst)
(if (< (distance (setq sp (vlax-curve-getStartPoint x)) midp)
(distance (setq ep (vlax-curve-getendPoint x)) midp)
)
(command "extend" ple "" (nentselp(vlax-curve-getStartPoint x))"")
(command "extend" ple "" (nentselp(vlax-curve-getendPoint x))"")
)
)
(command "zoom" "p" )
)
)
)
(command "erase" pless "")
(command "undo" "e")
(princ)
) yjr111 发表于 2012-8-7 19:49 static/image/common/back.gif
谢谢分享。
没有到达楼主的要求,线条未连接到改变后的圆 Andyhon 发表于 2012-8-7 15:49 static/image/common/back.gif
谢谢分享!
试了试,好像有误
比率: 0.5
【错误】no function definition: nil!*取消*