利用Autolisp提取天正墙体位置坐标

        天正建筑软件（TArch）提供了Autolisp接口供二次开发者读取天正自定义的对象属性，如下所示：

 ((-1 . <图元名: 7ff4569f40d0>) (0 . "TCH_WALL") (330 . <图元名: 7ff4569f29f0>) (5 . "2BD") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "WALL") (100 . "TDbCurveEntity") (46 . 0.0) (47 . 100.0) (68 . 0) (100 . "TDbWall") (38 . 0.0) (39 . 3000.0) (300 . "NAAxADMAOQAwAC4AOQAsADUANwA3ADIAOAAuADUALAAyADIANAAyADMALgA1ACwAMgAyADQAMgAzAC4ANQAsADAALAAwACwAMQA1ADAALAAxADUAMAA=") (42 . 80.16) (148 . 0.0) (149 . 3000.0) (50 . 0.0) (73 . 1) (74 . 50) (75 . 0) (90 . 3) (76 . 0) (411 . "PUB_HATCH") (412 . "0") (413 . "0") (414 . "0") (1 . "") (2 . ""))

         奇怪的是通过该接口暴露的信息，没有发现墙体位置坐标，可见通过常规组码方式行不通。笔者经过尝试后发现通过ActiveX可以提取到这一坐标，并成功将其用于天正墙体转Revit模型的翻模插件中。

  (prompt "墙体导出")
  (setq ss (ssget '((0 . "*WALL"))))
  (if ss (setq l (sslength ss)) (setq l 0))
  (setq path (strcat (getvar 'DWGPREFIX) "WalToRvt.fwd"))
  (setq i 0)
  (while (< i l)
    (setq ent (ssname ss i))
    (setq obj (vlax-ename->vla-object ent))
    (setq p0 (trans (vlax-curve-getStartPoint obj) 0 1))
    (setq p1 (trans (vlax-curve-getEndPoint obj) 0 1))
    (setq rt (vlax-get-property obj "RightWidth"))
    (setq lt (vlax-get-property obj "LeftWidth"))
    (setq wt (+ lt rt))
    (setq isArc (vlax-get-property obj "IsArc"))
    (setq isExternal (vlax-get-property obj "EnUsage"))
    (setq objName (vlax-get-property obj "ObjectName"))
    (if (= objName "TDbCurtainWall")
        (setq property (strcat isExternal "-" "玻璃幕墙"))
        (setq property (strcat isExternal "-" (vlax-get-property obj "Usage") "-" (vlax-get-property obj "Style")))
    )
    (if (= isArc "直墙")
        (progn ;_ 处理直墙
          (setq dis (/ (- rt lt) 2))
          (setq x0 (- (car p0) (car p1)))
          (setq y0 (- (cadr p0) (cadr p1)))
          (setq mod (sqrt (+ (* x0 x0) (* y0 y0))))
          (if (= mod 0) (setq mod 0.000001))
          (setq x (* dis (/ (- y0) mod)))
          (setq y (* dis (/ x0 mod)))
          (setq p0 (list (+ (car p0) x) (+ (cadr p0) y)))
          (setq p1 (list (+ (car p1) x) (+ (cadr p1) y)))
          (if (> (distance p0 p1) 10)
            (setq str (strcat (rtos (car p0) 2 6) "\t" (rtos (cadr p0) 2 6) "\t" (rtos (car p1) 2 6) "\t" (rtos (cadr p1) 2 6) "\t" (rtos wt 2 0) "\t" (rtos (car p0) 2 6) "\t" (rtos (cadr p0) 2 6) "\t" property))
          )
        )
        (progn ;_ 处理弧墙
          (setq param (/ (+ (vlax-curve-getEndParam obj) (vlax-curve-getStartParam obj)) 2))
          (setq p2 (vlax-curve-getPointAtParam obj param)) ;_ 圆弧中点坐标
          (if (> (distance (vlax-curve-getEndPoint obj) (vlax-curve-getStartPoint obj)) 10)
            (setq str (strcat (rtos (car p0) 2 6) "\t" (rtos (cadr p0) 2 6) "\t" (rtos (car p1) 2 6) "\t" (rtos (cadr p1) 2 6) "\t" (rtos wt 2 0) "\t" (rtos (car p2) 2 6) "\t" (rtos (cadr p2) 2 6) "\t" property))
          )
        )
    )
    (if (= i 0) (setq f (open path "w")) (setq f (open path "a")))
    (if str (write-line str f))
    (close f)
    (setq i (1+ i))
  )
  (if (> l 0) (alert (strcat "文件位置：" path)))
  (princ)