发两个非常英霸的直线工具（源码）！

Gu_xl

请解释一下英霸的含义！我Out啦？真不明白！

半听可乐

Gu_xl 发表于 2012-6-29 16:15
请解释一下英霸的含义！我Out啦？真不明白！

http://baike.baidu.com/view/2182764.htm

cnks

半听可乐 发表于 2012-6-29 16:12
网络流行语吧，貌似出自魔兽一款游戏的地图名字

了然

eeellleee

有意思的小程序，创

水如天

关联移动还是很有创意的

imaya

这东西好用，谢谢楼主

adc

又来踢馆了，发一个本论坛的，功能类似

半听可乐

adc 发表于 2012-6-30 11:29
又来踢馆了，发一个本论坛的，功能类似

动态拉伸这个就两行代码解决的事，咱的看点是关联移动哦，朋友

pimgu

转载;;Associate (SUPER) move----------------------------------------------------------------------
(defun c:m( / ss)
(prompt "Select objects:")(setq ss (ssget))
(if ss (command "move" ss "")(progn (princ "\n -->[Assosiate-Move]")
(#sm)))
(princ ))

(defun c:sm()(#sm))
(defun #sm()(setq olderr *error* *error* myerr)
(setq ot (getvar  "orthomode"))
(setvar "orthomode" 1)(move-1) (setvar "orthomode" ot)(setq *error* olderr) (princ))
(defun move-1(/ en ens enx ENT pt ss1 ss2 ss3 xlst xlsd p1 lst lsd n)
  
(defun #sms (en2 a b / p1 )
(if (vlax-curve-getparamatpoint en (dxf en2 a))(setq p1 a))
(if (vlax-curve-getparamatpoint en (dxf en2 b))(setq p1 b))
(if p1 (list en2 p1))    );

; main
(setvar "cmdecho" 0)(princ "\nSelect Objects: ")
(setq end (ssget))(setq ss2 (#ss2lst end))
  
(if (setq ens (ssget "p" '((0 . "LINE"))))
(progn ;(setq n 0 lst (list) lsd (list) )
       (repeat (setq n (sslength ens))
       (setq ent (entget (setq en (ssname ens (setq n (1- n))))))
       (setq ss1  (ssget "c" (dxf ent 10)(dxf ent 11) '((0 . "LINE")))
             xlst (vl-remove-if 'null (mapcar '(lambda (x) (#sms x 10 11))(lst-lst (#ss2lst ss1) ss2) ))
             ss3  (ssget "c" (dxf ent 10)(dxf ent 11) '((0 . "DIMENSION")))
             xlsd (vl-remove-if 'null (mapcar '(lambda (x) (#sms x 13 14))(lst-lst (#ss2lst ss3) ss2) )) )
       (setq lst  (cons (list en xlst ) lst ))
       (if xlsd (setq lsd (cons (list en xlsd) lsd)))
       );repeat
  ));if
   
(foreach ls xlsd  (redraw  (car ls) 3))
(setvar "cmdecho" 1)
(if end (command "move" end ""))
(while (/= 0 (getvar "cmdactive")) (command pause))
(setvar "cmdecho" 0)

(foreach lt lst
     (setq en (car lt) xlst (cadr lt))
     (foreach ls xlst (if (setq pt (car (#inpt en (car ls) 2) ))
                        (progn (setq p1 (cadr ls) enx (entget (car ls)))
                        (entmod (subst (cons p1 pt)(assoc p1 enx) enx))
            ));if
));2foreach

(foreach lt lsd   
    (setq en (car lt) xlsd (cadr lt))
    (foreach ls xlsd  
       (setq enx (entget (car ls)) p1 (cadr ls))
       (setq pt (vlax-curve-getClosestPointTo en (dxf enx p1) ))
       (entmod (subst (cons p1 pt)(assoc p1 enx) enx))
));foreach  
(princ))

(defun myerr(msg)(setq *error* olderr)  (setvar "orthomode" ot) (princ)  )

(defun #ss2lst (s / n ls) ;;;转换选择集为表
(if s (repeat (setq n (sslength s))(setq ls (cons (ssname s (setq n (1- n))) ls)))))

(defun lst-lst( a b ) (vl-remove-if '(lambda(x)(member x b)) a))
(defun dxf(ent i)(if (= (type ent) 'ename)(setq ent (entget ent)))(cdr (assoc i ent)))
(defun #inpt (e1 e2 k / lst lst2)
(setq lst (vlax-invoke(vlax-ename->vla-object e1)'intersectwith(vlax-ename->vla-object e2) k))
(if lst (repeat (/ (length lst) 3)(setq lst2 (cons (list (car lst)(cadr lst)(caddr lst)) lst2) lst (cdddr lst))))
(reverse lst2))

pimgu

这是哪位大哥的忘记了