帮忙做一LISP,对工作很有用！求最大外形！

qsb506

非常感谢oyxx1023 ，这个也是我一直想要的，在工作中确实很好用，我在你的基础上补上了画中心线的功能，画中心线的代码也是移植论坛上的一个LSP代码中的一部分，我只是将两者有机结合，希望能与LZ分享。
(defun c:test()
(setvar "osmode" 0)
(command "layer" "set" 1 "") 
(if (setq ent (car (entsel "\nselect object:")))
         (progn
(setq obj (vlax-ename->vla-object ent))
     (vla-GetBoundingBox obj 'pta 'ptb)
(vl-cmdf ".rectangle"
       (vlax-safearray->list pta)
       (vlax-safearray->list ptb)
     )
)
)
  (vl-load-com)
  (setq ent0  (entlast))
  (setq ent1 (entget ent0))
  (setq name (cdr (assoc 0 ent1)))
  (setq os (getvar "osmode"))
  (setq cmd (getvar "CMDECHO"))
  (setvar "cmdecho" 0)
  (setvar "OSMODE" 0)
;;;所选物体是矩形 
  (setq obj (vlax-Ename->Vla-Object ent0))
  (setq point (vlax-safearray->list
         (vlax-variant-value (vla-get-Coordinates obj))
       )
  )
  (if (= (length point) 8)
    (progn

      (setq p1 (list (nth 0 point) (nth 1 point))
     p2 (list (nth 2 point) (nth 3 point))
     p3 (list (nth 4 point) (nth 5 point))
     p4 (list (nth 6 point) (nth 7 point))
      )
      (setq center-point (mapcar '(lambda (a b) (/ (+ a b) 2))
     p1
     p3
    )
     ang1  (angle p1 p2)
     ang2  (angle p1 p4)
     d1  (distance p1 p2)
     d2  (distance p1 p4)
      )
      (setq point10 (polar center-point ang1 (+ (* d1 0.5) 5.0))
     point11 (polar center-point
      (+ ang1 pi)
      (+ (* d1 0.5) 5.0)
      )
     point20 (polar center-point ang2 (+ (* d2 0.5) 5.0))
     point21 (polar center-point
      (+ ang2 pi)
      (+ (* d2 0.5) 5.0)
      )
      )
      (command "LINE" point10 point11 "")
      (command "LINE" point20 point21 "")
    )
   
  )

  (setvar "OSMODE" os)
  (setvar "cmdecho" cmd)
  (princ)
)

 

kerrywm

以上程序，对于单个图元是不会有问题的，如果对于多个图元，选择时用SSGET就可以了，但是求其最大外形，得用以下程序，献丑了：

(DEFUN BOUNDINGBOX(SELOBJ / I YLINE0 MINEXT0X MINEXT0Y MAXEXT0X MAXEXT0Y
      YLINE MINEXT MAXEXT MINEXTX MINEXTY MAXEXTX MAXEXTY )
  (SETQ COUNTER(VLA-GET-COUNT SELOBJ))
  (IF (> COUNTER 0)
    (PROGN
      (IF (> COUNTER 1)
 (PROGN
   (SETQ I 0)
   (WHILE (< I COUNTER)
     (SETQ OBJ(VLA-ITEM SELOBJ I))
     (VLA-GETBOUNDINGBOX OBJ 'MINEXT 'MAXEXT)
     (SETQ MINEXTX (VLAX-SAFEARRAY-GET-ELEMENT MINEXT 0))
     (SETQ MINEXTY (VLAX-SAFEARRAY-GET-ELEMENT MINEXT 1))
     (SETQ MAXEXTX (VLAX-SAFEARRAY-GET-ELEMENT MAXEXT 0))
     (SETQ MAXEXTY (VLAX-SAFEARRAY-GET-ELEMENT MAXEXT 1))
     (IF (= I 0)
       (PROGN
  (SETQ MINEXT0X MINEXTX)
  (SETQ MINEXT0Y MINEXTY)
  (SETQ MAXEXT0X MAXEXTX)
  (SETQ MAXEXT0Y MAXEXTY)
  )
       )
     (IF (> MINEXT0X MINEXTX)(SETQ MINEXT0X MINEXTX))
     (IF (> MINEXT0Y MINEXTY)(SETQ MINEXT0Y MINEXTY))
     (IF (< MAXEXT0X MAXEXTX)(SETQ MAXEXT0X MAXEXTX))
     (IF (< MAXEXT0Y MAXEXTY)(SETQ MAXEXT0Y MAXEXTY))
     (SETQ I(1+ I))
     )
   )
 (PROGN
   (SETQ OBJ(VLA-ITEM SELOBJ 0))
   (VLA-GETBOUNDINGBOX OBJ 'MINEXT 'MAXEXT)
   (SETQ MINEXT0X (VLAX-SAFEARRAY-GET-ELEMENT MINEXT 0))
   (SETQ MINEXT0Y (VLAX-SAFEARRAY-GET-ELEMENT MINEXT 1))
   (SETQ MAXEXT0X (VLAX-SAFEARRAY-GET-ELEMENT MAXEXT 0))
   (SETQ MAXEXT0Y (VLAX-SAFEARRAY-GET-ELEMENT MAXEXT 1))
   )
 )
      (SETQ MINEXT0 (LIST MINEXT0X MINEXT0Y))
      (SETQ MAXEXT0 (LIST MAXEXT0X MAXEXT0Y))
      )
    (PROGN
      (ALERT "您未选中任何图元！")
      (VL-EXIT-WITH-VALUE 0)
      )
    )
  (LIST MINEXT0 MAXEXT0)
  )

chilam

kerrywm,你的提议是很好的，可以一次选多个图元，而且不用把它转成PL线，但你的LSP好像不能用，请帮忙再修改修改！

oyxx1023

to chilam:

这个程序对于单个的图元是通用的，如果要满足SSGET多选的话，你可以把十二楼的程序改一下，或者用ET的扩展函数。

HGQ8888

各位大虾,上面那些程序最好就是选多个时只产生一个矩形(包含所有的图素),然后可以输入一个能将矩形偏移多少的值(默认为0).

linheyuanpcb

哪位高手能改一下程序达到以下要效果?

单击闭合的一个图形（不规则的图,有圆或孤)后在ＣＵＴ层生成一个新的图形<颜色:红色>(大小等与旧图不变)

谢谢

先进者

kerrywm 发表于 2006-11-29 23:15
以上程序，对于单个图元是不会有问题的，如果对于多个图元，选择时用SSGET就可以了，但是求其最大外形，得用 ...

能不能放到一个文件里面传上来,我复制了用不了,谢谢