马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
本帖最后由 newer 于 2016-5-9 15:52 编辑
根据这个帖子的申请整理后提供个插件。http://bbs.xdcad.net/thread-704143-1-1.html
[sell=3] - (defun c:XDTB_PolyFileRead ( / bulge bulges clr clr1 cw e ews f ff fn isclosed lyr lyr1 new nums old px py sw sws x)
- (if (setq fn (xdrx_system_selectFiles "选取POLYLINE信息文件名" "" "txt" 0))
- (progn
- (setq ff nil
- bulges nil
- sws nil
- ews nil
- )
- (if (setq f (XD::List:FromFile (car fn)))
- (progn
- (setq nums 0)
- (mapcar
- '(lambda (x)
- (if (xdrx_string_find x "闭合")
- (setq isclosed t)
- )
- (if (setq lyr (XD::String:MatchNumAfter x "图层:" nil))
- (setq lyr1 (car lyr))
- )
- (if (setq clr (XD::String:MatchNumAfter x "颜色:" nil))
- (setq clr1 (car clr))
- )
- (if (setq cw (XD::String:MatchNumAfter x "固定宽度" nil))
- (setq cw (car cw))
- )
- (if (and
- (xdrx_string_find x "于端点")
- (setq px (XD::String:MatchNumAfter x "x=" nil))
- (setq py (XD::String:MatchNumAfter x "y=" nil))
- )
- (setq ff (cons (list (atof (car px)) (atof (car py))) ff)
- nums (1+ nums)
- )
- )
- (if (setq sw (XD::String:MatchNumAfter x "起点宽度" nil))
- (setq sws (cons (list (- nums 1) (atof (car sw))) sws))
- )
- (if (setq sw (XD::String:MatchNumAfter x "端点宽度" nil))
- (progn
- (setq old (assoc (- nums 1) sws)
- new (append
- old
- (list (atof (car sw)))
- )
- sws (subst
- new
- old
- sws
- )
- )
- )
- )
- (if (setq bulge (XD::String:MatchNumAfter x "凸度" nil))
- (setq bulges (cons (list (- nums 1) (atof (car bulge)))
- bulges
- )
- )
- )
- )
- f
- )
- (setq ff (reverse ff))
- (setq e (xdrx_polyline_make ff))
- (mapcar
- '(lambda (x)
- (xdrx_setpropertyvalue e "bulgeat" x)
- )
- bulges
- )
- (mapcar
- '(lambda (x)
- (xdrx_setpropertyvalue e "widthat" x)
- )
- sws
- )
- (if isclosed
- (xdrx_setpropertyvalue e "isclosed" t)
- )
- (if cw
- (xdrx_setpropertyvalue e "ConstantWidth" cw)
- )
- (xdrx_setpropertyvalue e "layer" lyr1)
- (xdrx_setpropertyvalue e "color" (atoi clr1))
- )
- )
- )
- )
- (princ)
- )
[/sell] |