这个功能有没? 位置自动移整

linheyuanpcb

在屏幕上随便放一个圆然后通过lisp选择，从圆心自动调整位置
如:位置是 10,10 这样就不理会!
如果是 10.2500,10,1300 这样 就调整 [四舍五入?] 为 10,10 这样可以吗, 期待下

highflybird

(vl-load-com)

;;;*****************************************************
;;;对CAD的一些东西归整，就是把零碎的小数归整。         
;;;适用于斯维尔，天正，直线，圆，弧，多段线，块的插入点
;;;可以自定义容差                                       
;;;*****************************************************
(defun c:gz( /  *DOC ENT I LOCKS OBJ PNT SEL STR TOL)
  (setq *doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vla-StartUndoMark *doc)                                        ;设置回退标志
  (setq locks (unlock_all_layers *doc))                                ;解锁所有层
  (setq TOL (getvar "USERR1"))                                        ;检测是否已设置容差
  (if (= TOL 0.0)
    (progn
      (setq TOL 5.0)                                                ;默认容差为5
      (setvar "USERR1" TOL)                                       
    )
  )
  (setq str "\n请选取点[设置(Set)]<")                                ;拾取基准点
  (setq str (strcat str (rtos TOL 2 0) ">:"))
  (initget "Set")
  (setq pnt (getpoint str))                                       
  (if (= pnt "Set")                                                ;如果需要设置参数
    (progn
      (setq TOL (getdist "\n请输入容差:"))                        ;设置容差
      (setq pnt (getpoint "\n请选取点:"))
      (setvar "USERR1" TOL)
    )
  )
  (if (null pnt)
    (setq pnt '(0 0 0))                                                ;默认基准点为'(0 0 0)
  )
  (setq pnt (trans pnt 1 0))                                        ;转化坐标系
  (setq sel (ssget '((0 . "CIRCLE,ARC,ELLIPSE"))))
  (setq i 0)
  (repeat (sslength sel)                                        ;对选择集的每个实体
    (setq ent (ssname sel i))
    (setq obj (vlax-ename->vla-object ent))                       
    (bp ent pnt TOL)                                                ;进行归整
    (setq i (1+ i))
  )
  (restore_locked_layers locks)                                        ;恢复以前图层状态
  (vla-EndUndoMark *doc)                                        ;回退标志结束
  (princ)
)

;;;*****************************************************
;;;归整主函数                                               
;;;参  数: ent  图元                                       
;;;        pnt  基点                                       
;;;        tol  容差                                       
;;;返回值: 无                                                
;;;*****************************************************
(defun bp (ent pnt TOL / DXF P1X P1Y P2X P2Y PT1 PT2 I OBJ PAR typ)
  (setq dxf (entget ent))
  (setq typ (cdr (assoc 0 dxf)))       
  (cond
    ( (or (= "CIRCLE" (cdr (assoc 0 dxf)))
          (= "ARC" (cdr (assoc 0 dxf)))
      )
      (setq obj (vlax-ename->vla-object ent))
      (setq pt1 (vla-get-center obj))
      (setq pt1 (3da->3dL pt1))
      (setq pt1 (mapcar '- pt1 pnt))
      (setq p1x (car pt1))
      (setq p1y (cadr pt1))
      (setq p1x (cl p1x TOL))
      (setq p1y (cl p1y TOL))
      (setq pt1 (list p1x p1y 0))
      (setq pt1 (mapcar '+ pt1 pnt))
      (setq pt1 (3dL->3dA pt1))
      (vla-put-center obj pt1)
    )
  )
)
;;;判断容差范围
(defun cl (x TOL / r h)
  (setq r (rem x TOL))
  (setq h (/ TOL 2.))
  (if (> (abs r) h)
    (if (< x 0)
      (- x r TOL)
      (- x r (- TOL))
    )
    (- x r)
  )
)
;;;表转化为安全数组(3d)
(defun 3dL->3dA (pt)
  (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 2)) pt)
)
;;;安全数组转化为表(3d)
(defun 3dA->3dL (pt)
  (vlax-safearray->list (vlax-variant-value pt))
)
;;;表转化为安全数组(3d)
(defun 2dL->2dA (pt)
  (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 1)) pt)
)
;;;解锁和解冻所有的图层
(defun unlock_all_layers (*DOC / locks)
  (vlax-map-collection
    (vla-get-layers *DOC)
    '(lambda (x)
       (cond ((= (vla-get-lock x) :vlax-true)
              (setq locks (cons x locks))
              (vla-put-lock x :vlax-false)
             )
       )
     )
  )
(reverse locks)
)
;;;恢复以前图层的状态
(defun restore_locked_layers (locks /)
  (if locks
    (mapcar '(lambda (x)
               (vla-put-lock x :vlax-true)
             )
            locks
    )
  )
)

snddd2000

想用entsel还是批量的ssget？

linheyuanpcb

批量 谢谢

linheyuanpcb

highflybird 你好那如果圆内有线或者其它能不能跟着选择了一起移？

highflybird

等下，我看看
完全可以的啊。

linheyuanpcb

如果圆内有 line texe mtext BHATCH之类的东东,
也随着圆心的位置更改了，但line text mtext BHATCH原来的位置相对圆是没变的，只是跟随圆心移动
谢谢

highflybird

这个就不是你原来的要求了哦。呵呵。另外你没考虑到如果圆形里面有交叉的部分呢？圆形和圆形里面的东西如果交叉呢？你又以哪个为基准呢？所以你得先自己考虑清楚规则。圆里面的东西，是怎样个里面？ 多边形框选， 多边形交选方式？

linheyuanpcb

嗯。只实现圆位置OK了，呵！！后面的要求能否再做下更改，

highflybird

回复 linheyuanpcb 的帖子

如果圆与圆互不交叉的话，那程序修改一下是完全可以达到你的要求的。