物件居中问题
找了很多论坛的居中效果都没有看到类似的有没有A物件的相对位置不变居中在B物件上
现在的办法都是用小笨的中心线实施这个效果
抓取两物件的中心线居中放
(defun c:tt (/ A B CP1 CP2 E LL1 LL2 N1 N2 RU1 RU2 S1 S2)
(princ "\n选择第一组物件:")
(setq s1 (ssget))
(princ "\n选择第二组物件:")
(setq s2 (ssget))
(if (and s1 s2)
(progn
(repeat (setq n1 (sslength s1))
(setq e (ssname s1 (setq n1 (1- n1))))
(vla-GetBoundingBox (vlax-ename->vla-object e) 'a 'b)
(if ll1
(setq ll1 (apply
'mapcar
(cons
'min
(cons ll1 (mapcar 'vlax-safearray->list (list a b)))
)
)
ru1 (apply
'mapcar
(cons
'max
(cons ru1 (mapcar 'vlax-safearray->list (list a b)))
)
)
)
(setq ll1 (apply
'mapcar
(cons 'min (mapcar 'vlax-safearray->list (list a b)))
)
ru1 (apply
'mapcar
(cons 'max (mapcar 'vlax-safearray->list (list a b)))
)
)
)
)
(setq a nil
b nil
)
(setq cp1 (mapcar '* (mapcar '+ ll1 ru1) '(0.5 0.5 0.5)))
(repeat (setq n2 (sslength s2))
(setq e (ssname s2 (setq n2 (1- n2))))
(vla-GetBoundingBox (vlax-ename->vla-object e) 'a 'b)
(if ll2
(setq ll2 (apply
'mapcar
(cons
'min
(cons ll2 (mapcar 'vlax-safearray->list (list a b)))
)
)
ru2 (apply
'mapcar
(cons
'max
(cons ru2 (mapcar 'vlax-safearray->list (list a b)))
)
)
)
(setq ll2 (apply
'mapcar
(cons 'min (mapcar 'vlax-safearray->list (list a b)))
)
ru2 (apply
'mapcar
(cons 'max (mapcar 'vlax-safearray->list (list a b)))
)
)
)
)
(setq cp2 (mapcar '* (mapcar '+ ll2 ru2) '(0.5 0.5 0.5)))
(command "_.move" s1 "" (trans cp1 0 1) (trans cp2 0 1))
)
)
(princ)
)
[*];;;;取中点函数---enam 实体名-----------------------（一级）------------------------------
[*](defun e-mid (enam / ent typ obj cen_po pt pt10 pt13 pt14 pt15 dis ang)
[*](setq ent (entget enam))
[*](setq typ (dxf1 ent 0))
[*](if (= typ "LINE")
[*] (setq pt (yy:mid (dxf1 ent 10) (dxf1 ent 11)))
[*])
[*](if (or (= typ "ARC") (= typ "SPLINE") (and (or (= typ "LWPOLYLINE") (= typ "POLYLINE")) (= (fy-recP enam) nil))) ;;;矩形非闭合多义线
[*] (progn
[*] (setq obj (en2obj enam))
[*] (setq dis (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))
[*] (setq pt (vlax-curve-getPointAtDist obj (* dis 0.5))) ;取得中点
[*] )
[*])
[*](if (= typ "CIRCLE")
[*] (setq pt (dxf1 ent 10))
[*])
[*](if (= typ "DIMENSION")
[*] (progn
[*] (if (= (dxf1 ent 70) 37) ;;圆弧标注
[*] (progn
[*] (setq pt11 (dxf1 ent 11))
[*] (setq pt15 (dxf1 ent 15))
[*] (setq ang (angle pt11 pt15))
[*] (setq pt (polar pt11 ang (* (getvar "dimscale") (+ (* (getvar "dimtxt") 0.5) (getvar "dimgap")))))
[*] )
[*] )
[*] (if (= (dxf1 ent 70) 34) ;;角度标注
[*] (progn
[*] (setq pt11 (dxf1 ent 11))
[*] (setq pt13 (dxf1 ent 13))
[*] (setq pt15 (dxf1 ent 15))
[*] (setq ang (angle pt11 (yy:mid pt13 pt15)))
[*] (setq pt (polar pt11 ang (* (getvar "dimscale") (+ (* (getvar "dimtxt") 0.5) (getvar "dimgap")))))
[*] )
[*] )
[*] (if (vl-position "AcDbAlignedDimension" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 100)) ent))) ;;;如果对齐32 线性 33 标注
[*] (progn
[*] (setq pt11 (dxf1 ent 10))
[*] (setq pt13 (dxf1 ent 13))
[*] (setq pt14 (dxf1 ent 14))
[*] (setq dis (distance pt14 pt13))
[*] (setq ang (angle pt14 pt13))
[*] (setq pt (polar pt10 ang (* dis 0.5)))
[*] )
[*] )
[*] (if (null pt)
[*] (setq pt (dxf1 ent 11));;;标注文字中心，近似中点
[*] )
[*] )
[*])
[*](if (or (= typ "TEXT") (= typ "MTEXT"))
[*] (setq pt (yy:mid (car (txbox enam nil)) (caddr (txbox enam nil))))
[*])
[*](if (null pt)
[*] (setq cen_po (get-box (SL:PickSet-fromList (list enam)))
[*] pt (yy:mid (car cen_po) (cadr cen_po))
[*] )
[*])
[*]pt
[*])
[*];;----------------------------------------------------------------------------------------------
G大出手,就是不一样阿,是我想要的效果 G版又现江湖，支持支持 Gu_xl 发表于 2020-3-19 11:47
终于重出江湖了 G版又现江湖，支持支持 Gu_xl 发表于 2020-3-19 11:47
希望能实现这样的功能:handshake
Gu_xl 发表于 2020-3-19 11:47
借楼问G版一个问题，不打开图的情况下，有没有办法执行类似于zoom那个的命令。即选择一个dwg文件后让其zoom到指定的角点坐标 批量执行某命令即可.很多批量工具. 依然小小鸟 发表于 2020-3-20 13:34
希望能实现这样的功能
我的表格对齐工具,支持单行多行混排,水平竖直文本.只对齐文字,暂不处理其它图形.