发现dbx方式处理文字bug一枚

q3_2006 · 发表于 2017-12-1 21:24:29

marting 发表于 2017-12-1 21:18

修复了一下..能打开了...修复提示有两个错误

marting · 发表于 2017-12-1 21:49:02

q3_2006 发表于 2017-12-1 21:24

方法是可行的，试试用 VLA 改下纯LISP代码，应该不会有错误的。

sicky111 · 发表于 2017-12-2 00:03:28

都用上18了啊

marting · 发表于 2017-12-2 00:48:32

q3_2006 发表于 2017-12-1 21:24

改成VLA，你试试下面的

;从对齐点反算插入点
(defun XD::TEXT:AlignPnt2InsertPnt (obj / alignment alipnt box rot)
(setq alignment (vlax-get obj 'alignment))
(setq alipnt (vlax-get obj 'textalignmentpoint)
rot (vlax-get obj 'rotation)
box (textbox (entget (vlax-vla-object->ename obj)))
)
(cond
((or
(= alignment acAlignmentTopRight)
(= alignment acAlignmentMiddleRight)
(= alignment acAlignmentBottomRight)
(= alignment acAlignmentRight)
)
(mapcar
'-
alipnt
(list (* (cos rot) (caadr box)) (* (sin rot) (caadr box)) 0.0)
)
)
((or
(= alignment acAlignmentCenter)
(= alignment acAlignmentTopCenter)
(= alignment acAlignmentMiddleCenter)
(= alignment acAlignmentBottomCenter)
)
(mapcar
'-
alipnt
(list (* (cos rot) (/ (caadr box) 2.0)) (* (sin rot) (/
(caadr box)
2.0
)
) 0.0
)
)
)
(t
(vlax-get obj 'InsertionPoint)
)
)
)
(defun c:tt (/)
(setq ffn "d:\\1.dwg"
dbx (vla-GetInterfaceObject (vlax-get-acad-object) (if (<
(setq acVer
(atoi
(getvar "ACADVER")
)
)
16
)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument."
(itoa acVer)
)
)
)
)
(Vlax-Invoke-Method dbx 'Open ffn)
(vlax-for ob (Vlax-Get dbx 'ModelSpace) (cond
((= "AcDbText"
(Vlax-Get ob 'ObjectName)
)
(cond
((= "aaa" (Vlax-Get ob 'TextString))
(Vlax-Put ob 'TextString
"bbbbbbbbbb"
)
(setq int1
(XD::TEXT:AlignPnt2InsertPnt ob)
)
(vlax-put ob
'InsertionPoint
int1
)
)
)
)
)
) ; (vla-auditinfo dbx :vlax-true)
(Vlax-Invoke-Method dbx 'SaveAs ffn)
(vlax-release-object dbx)
(princ)
)

;从对齐点反算插入点 
(defun XD::TEXT:AlignPnt2InsertPnt (obj / alignment alipnt box rot) 
  (setq alignment (vlax-get obj 'alignment)) 
  (setq alipnt (vlax-get obj 'textalignmentpoint) 
        rot (vlax-get obj 'rotation) 
        box (textbox (entget (vlax-vla-object->ename obj))) 
  ) 
  (cond 
    ((or 
       (= alignment acAlignmentTopRight) 
       (= alignment acAlignmentMiddleRight) 
       (= alignment acAlignmentBottomRight) 
       (= alignment acAlignmentRight) 
     ) 
      (mapcar 
        '- 
        alipnt 
        (list (* (cos rot) (caadr box)) (* (sin rot) (caadr box)) 0.0) 
      ) 
    ) 
    ((or 
       (= alignment acAlignmentCenter) 
       (= alignment acAlignmentTopCenter) 
       (= alignment acAlignmentMiddleCenter) 
       (= alignment acAlignmentBottomCenter) 
     ) 
      (mapcar 
        '- 
        alipnt 
        (list (* (cos rot) (/ (caadr box) 2.0)) (* (sin rot) (/ 
                                                                (caadr box) 
                                                                2.0 
                                                             ) 
                                                ) 0.0 
        ) 
      ) 
    ) 
    (t 
      (vlax-get obj 'InsertionPoint) 
    ) 
  ) 
)       
(defun c:tt (/) 
  (setq ffn "d:\\1.dwg" 
        dbx (vla-GetInterfaceObject (vlax-get-acad-object) (if (< 
                                                                  (setq acVer 
                                                                        (atoi 
                                                                              (getvar "ACADVER") 
                                                                        ) 
                                                                  ) 
                                                                  16 
                                                               ) 
                                                             "ObjectDBX.AxDbDocument" 
                                                             (strcat "ObjectDBX.AxDbDocument." 
                                                                     (itoa acVer) 
                                                             ) 
                                                           ) 
            ) 
  ) 
  (Vlax-Invoke-Method dbx 'Open ffn) 
  (vlax-for ob (Vlax-Get dbx 'ModelSpace) (cond 
                                            ((= "AcDbText" 
                                                (Vlax-Get ob 'ObjectName) 
                                             ) 
                                              (cond 
                                                ((= "aaa" (Vlax-Get ob 'TextString)) 
 
                                                  (Vlax-Put ob 'TextString 
                                                            "bbbbbbbbbb" 
                                                  ) 
                                                  (setq int1 
                                                        (XD::TEXT:AlignPnt2InsertPnt ob) 
                                                  ) 
                                                  (vlax-put ob 
                                                            'InsertionPoint 
                                                            int1 
                                                  ) 
                                                ) 
                                              ) 
                                            ) 
                                          ) 
  )                                       ; (vla-auditinfo dbx :vlax-true) 
  (Vlax-Invoke-Method dbx 'SaveAs ffn) 
  (vlax-release-object dbx) 
  (princ) 
)

q3_2006 · 发表于 2017-12-2 05:53:23

marting 发表于 2017-12-2 00:48

谢谢大师...昨晚休息了..今天继续测试

q3_2006 · 发表于 2017-12-2 05:58:20

marting 发表于 2017-12-2 00:48

太棒了..行得通..

q3_2006 · 发表于 2017-12-2 06:49:34

marting 发表于 2017-12-2 00:48

这是全部15种对齐方式..处理后对比如截图我已经搞晕了..

账号		自动登录	找回密码
密码			立即注册

[求助] 发现dbx方式处理文字bug一枚

浏览过的版块