天正建筑软件(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)