板筋镜像-点选版（源码共享给大家）
本帖最后由 叶曲冰寒 于 2015-2-6 12:54 编辑;;;文字前处理[程序]
;;;处理文字转角90°在0.001°误差内全部处理成90°
(defun C:BJQCL(/ sstxt txti)
(setq ssTxt (ssget "all" '((0 . "TEXT"))))
(if ssTxt
(progn
(setq txti 0)
(repeat (sslength ssTxt)
(if (< (abs (- 90 (* (vla-get-Rotation (vlax-ename->vla-object (ssname ssTxt txti))) (/ 180 pi)))) 0.001)
(vla-put-Rotation (vlax-ename->vla-object (ssname ssTxt txti)) (* 90 (/ pi 180)))
)
(setq txti (1+ txti))
)
(print (read "=======文字已经过修正处理。。。"))
(print)
(princ)
)
)
)
(C:BJQCL)
(setvar "MIRRTEXT" 0)
;;;板筋镜像-点选版(新版)[程序]
(prompt "=======欢迎使用板筋镜像程序，此版本为点选版本，后续会发布框选版本，尽请期待!!")
(print)
(prompt "=======执行板筋镜像前建议先进行板筋前处理(BJQCL)避免竖向钢筋文字90度转角不精确情况=======")
(print)
(prompt "=======作者:Helchan======QQ群:425314779=======")
(print)
(print "******版本号2.1******")
(print)
(defun c:BJJX(/ 02i 04i 06st 07i 07j 08ang1 08ang2 08dd 09cp_lst 09i 09ss 09sscp 10i ddang ename inters_pt layernewfs layernewtxt lst_basefslayer lst_basefslayertxt lst_fspt new_text_insert_pt num_pt pt1 pt2 pt3 pt4 pta ptb ptta pttb ss_01fs ss_03fstxt text_insert_pt text_inserts_pt_dd 文字转角)
;;01.获取基准板筋图层while循环【ss_01Fs】
(while (not (setq ss_01Fs (cadr (list (print (read "请点选板筋用于图层识别:")) (ssget))))))
;;02.将获取到的板筋取出图层名组成板筋图层名基准表【lst_BaseFsLayer】
(setq lst_BaseFsLayer nil)
(setq 02i 0)
(repeat (sslength ss_01Fs)
(if (not (member (setq layerNewFs (cdr (assoc 8 (entget (ssname ss_01Fs 02i))))) lst_BaseFsLayer))
(setq lst_BaseFsLayer (cons layerNewFs lst_BaseFsLayer))
)
(setq 02i (1+ 02i))
);;end repeat
;;03.获取基准板筋文字图层while循环【ss_03FsTxt】
(while (not (setq ss_03FsTxt (cadr (list (print (read "请点选板筋文字用于图层识别:")) (ssget)))))(print))
;;04.将获取到的板筋文字取出图层名组成板筋文字图层名基准表【lst_BaseFsLayerTxt】
(setq lst_BaseFsLayerTxt nil)
(setq 04i 0)
(repeat (sslength ss_03FsTxt)
(if (not (member (setq layerNewTxt (cdr (assoc 8 (entget (ssname ss_03FsTxt 04i))))) lst_BaseFsLayerTxt))
(setq lst_BaseFsLayerTxt (cons layerNewTxt lst_BaseFsLayerTxt))
)
(setq 04i (1+ 04i))
);;end repeat
;;05.根据点选的板筋对板筋进行处理while大循环
(while T
;;06.点选钢筋循环，如果是pl且根据图层分析在板筋图层则跳出此while循环
(setq 06st T)
(while 06st
(setq ename (car (entsel "请点选板钢筋:")))
;;如果获取到了图元【ename】
(if ename
;;如果获取的图元是多段线，且图层是板筋图层
(if (and (member (cdr (assoc 8 (entget ename))) lst_BaseFsLayer) (= "LWPOLYLINE" (cdr (assoc 0 (entget ename)))))
(progn
;;存储板筋多段线顶点的表【lst_FsPt】
(setq lst_FsPt nil)
;;start foreach 将顶点存储到顶点表中
(foreach tempt (entget ename)
(if (= (car tempt) 10)
(setq lst_FsPt (cons (cdr tempt) lst_FsPt))
);;end if
);;end foreach
;;顶点数num_Pt
(setq num_Pt (length lst_FsPt))
;;07.如果顶点数是2个,取得左下角点【pta】,右上角点【ptb】
(setq 07i nil)
(setq 07j nil)
(if (= (rem num_Pt 2) 0)
(progn
(setq 07i (- (/ num_Pt 2) 1))
(setq 07j (/ num_Pt 2))
)
);;end if
(if (and 07i 07j)
(progn
(setq ptta (nth 07i lst_FsPt))
(setq pttb (nth 07j lst_FsPt))
(if (or (and (>= (angle ptta pttb) 0) (<= (angle ptta pttb) (* 0.5 pi))) (and (> (angle ptta pttb) (* 1.5 pi)) (< (angle ptta pttb) (* 2 pi))))
(progn
(setq pta ptta)
(setq ptb pttb)
)
(progn
(setq pta pttb)
(setq ptb ptta)
)
);;end if
;;=============08.获取到了板筋的两个顶点pta 和ptb后进行后续处理===============
;;设定窗交范围【08dd】
(setq 08dd 180)
;;获得窗交的四个点【pt1 pt2 pt3 pt4】
(setq 08ang1 (+ (* pi 0.5) (angle pta ptb)))
(setq 08ang2 (+ (* pi 1.5) (angle pta ptb)))
(setq pt1 (polar pta 08ang1 08dd))
(setq pt2 (polar pta 08ang2 08dd))
(setq pt3 (polar ptb 08ang2 08dd))
(setq pt4 (polar ptb 08ang1 08dd))
;;09.获取窗交文字选择集09ss
(setq 09cp_Lst (list pt1 pt2 pt3 pt4))
(setq 09ssCp (ssget "CP" 09cp_Lst '((0 . "TEXT"))))
(setq 09i 0)
;;过滤出图层不对的文字和角度不对的文字***********************
(if 09ssCp
(progn
(setq 09ss (ssadd))
(repeat (sslength 09ssCp)
;;设定文字误差角为3°
(setq ddang (* 3 (/ pi 180)))
(setq 文字转角 (vla-get-Rotation (vlax-ename->vla-object (ssname 09ssCp 09i))))
(if (and (member (cdr (assoc 8 (entget (ssname 09ssCp 09i)))) lst_BaseFsLayerTxt)(if (< (- (angle pta ptb) ddang) 0)
(or (> 文字转角 (- (+ (* pi 2) (angle pta ptb)) ddang)) (< 文字转角 (+ (angle pta ptb) ddang)))
(if (> (+ (angle pta ptb) ddang) (* 2 pi))
(or (> 文字转角 (- (angle pta ptb) ddang)) (< 文字转角 (- (+ (angle pta ptb) ddang) (* 2 pi))))
(and (> 文字转角 (- (angle pta ptb) ddang)) (< 文字转角 (+ (angle pta ptb) ddang)))
)
))
(setq 09ss (ssadd (ssname 09ssCp 09i) 09ss))
)
(setq 09i (1+ 09i))
)
)
)
;;10.对文字选择集进行特殊处理
(if 09ss
(if (> (sslength 09ss) 0)
(progn
(setq 10i 0)
(repeat (sslength 09ss)
(setq text_insert_pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint (vlax-ename->vla-object (ssname 09ss 10i))))))
(setq inters_pt (inters pta ptb text_insert_pt (polar text_insert_pt 08ang1 10) nil))
(setq text_inserts_pt_dd (distance text_insert_pt inters_pt))
(if (> text_inserts_pt_dd 200)
(setq text_inserts_pt_dd (- text_inserts_pt_dd (vla-get-Height (vlax-ename->vla-object (ssname 09ss 10i)))))
(setq text_inserts_pt_dd (+ text_inserts_pt_dd (vla-get-Height (vlax-ename->vla-object (ssname 09ss 10i)))))
)
(setq new_text_insert_pt (polar inters_pt (angle text_insert_pt inters_pt) text_inserts_pt_dd))
;;设置文字无对齐点以便直接改变插入点就可更改文字位置
(vla-put-Alignment (vlax-ename->vla-object (ssname 09ss 10i)) 0)
(vla-put-InsertionPoint (vlax-ename->vla-object (ssname 09ss 10i)) (vlax-3D-point new_text_insert_pt))
(setq 10i (1+ 10i))
);;end repeat
)
)
)
;;11.对钢筋进行镜像处理
(vla-Mirror (vlax-ename->vla-object ename) (vlax-3D-point pta) (vlax-3D-point ptb))
(vla-Delete (vlax-ename->vla-object ename))
)
);;end if
)
)
);;end if
(print)
)
)
)
果断收藏了，学习学习 牛牛牛，果断收藏！ 收藏了，学习学习!!!! 果断收藏了 代码太复杂了，顶顶 果断收藏了，学习学习 果断收藏了，学习学习 结构同行啊，支持 果断收藏了，学习学习 挺好的程序
页:
[1]
2