357785513 发表于 2012-8-7 14:45:08

自动连上

各位大虾,
我想把圆灯缩小一半后灯两边的连线还是连上的,但每个灯的位还不能变动它,有没有更块的办法.烟为以前酒詀的灯做大了
现在又想改小,所以要缩小

Andyhon 发表于 2012-8-7 15:49:30

本帖最后由 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))
   ) )
)

YYHappy1314 发表于 2012-8-7 16:15:13

快捷键是什么呀,没反应呢

仲文玉 发表于 2012-8-7 17:07:43

缺少函数吧:acet-ent-geomextents

userzhl 发表于 2012-8-7 17:13:43

需要安装ET

357785513 发表于 2012-8-7 17:34:26

; 错误: *error* 函数中出错函数被取消
不像四楼所说的那样
但出现了新的问题

xyp1964 发表于 2012-8-7 18:36:27




yjr111 发表于 2012-8-7 19:49:47

(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)
)

461045462 发表于 2012-8-7 20:15:46

yjr111 发表于 2012-8-7 19:49 static/image/common/back.gif


谢谢分享。
没有到达楼主的要求,线条未连接到改变后的圆

461045462 发表于 2012-8-7 20:27:16

Andyhon 发表于 2012-8-7 15:49 static/image/common/back.gif


谢谢分享!
试了试,好像有误
比率: 0.5
【错误】no function definition: nil!*取消*
页: [1] 2 3
查看完整版本: 自动连上