- UID
- 2386
- 积分
- 330
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2002-2-2
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;电力电缆 --dldl
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dldl ( / bh dxif d_d d_d1 errold k_k k_kk layna nep pdx plkd
ptlst stp tscale ucmark ucs_fo xlsjl d_stp d_nep1 d_nep2
osif C_PLAL C_GJPT C_SBOS OLDOS)
(setq errold *error*)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;定义自己的错误函数
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun *error* (msg / )
(if (/= msg "quit / exit abort")(progn
(Hidexl3)
(if (= ucmark 0)
(command "_.ucs" "_prev")
)
(command "_.undo" "_end")
(setq *error* errold)
(setq ssen nil sse2 nil sbe2 nil sbe1 nil lst nil intl nil intenl nil
int nil ii nil ent1 nil el nil edp nil brad nil bcen nil angs nil
ange nil en1 nil sse1 nil en nil p4 nil xlbznr nil tmpl2 nil
tmpl1 nil i nil ent nil xsbl nil tmpl nil pp2 nil p22 nil p11 nil
ang3 nil an3 nil pp1 nil an2 nil an1 nil csa nil len nil rad nil
p3 nil dis nil cen nil ang2 nil ang12 nil ang11 nil ang1 nil
ang nil td nil p2 nil p1 nil p_cen nil atran nil p_xzp nil
p_jdpd nil p_ctpl nil p_gxl nil p_ddwp nil p_ptpd nil p_xdtk nil
p_pla nil p_pll nil flag nil ts nil fh nil msg nil d_nep2 nil
d_nep1 nil d_stp nil xlsjl nil ucs_fo nil ucmark nil tscale nil
stp nil ptlst nil plkd nil pdx nil nep nil layna nil k_kk nil
k_k nil errold nil d_d1 nil d_d nil dxif nil bh nil
oldos nil osif nil C_PLAL nil C_GJPT nil C_SBOS nil OLDOS nil
dotlst nil inspt nil kname nil l1 nil l2 nil lkname nil pzx nil
retv nil sjwj nil x nil y nil z nil p_xldd nil
)
(_resdwg)
)(setq *error* errold errold nil))
(princ)
)
;;;;;------------------------------------------------------------------
;;;;;公用函数开始
;;;;;------------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;pline--线缆打断并压入回路信息(各种扩展实体数据)的公用函数
;;输入:1---起点;
;; 2---终点;
;; 3---所属配电箱;
;; 4---回路编号;
;; 5---当前图层;
;; 6---pline线宽度;
;; 7---跨接距离;
;; 8---打断距离;
;; 9---(1:跨接,0:不跨接)
;; 10--(1:打断,0:不打断)
;; 11--图纸比例
;; 12--线弧判断标记 (1-直线,0-弧线)
;; 13--判断是否捕捉设备的关键点(1-捕捉 0-不捕捉)
;;返回:弧线时返回弧线的第三点,直线返回nep
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C_plal (stp nep pdx bh layna plkd d_d d_d1 k_k dxif tscale
flag osif / p_pll p_pla p_xdtk p_ptpd p_ddwp p_gxl p_ctpl
p_jdpd p_xzp atran p_cen xlsjl p_xldd)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 功能: 求POLYLINE弧部分的圆心
;;输入参数: 始点,终点,始点凸度
;; 返回值: 圆心坐标
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_cen (p1 p2 td / ang ang1 ang11 ang12 ang2 cen dis p3 rad)
(if (< td 0)(setq td (- td) p3 p1 p1 p2 p2 p3))
(setq dis (distance2p p1 p2) ang (angle p1 p2))
(setq ang11 (* 2 (atan td)) ang12 (- (* 0.5 pi) ang11))
(setq ang1 (atran (- (+ ang ang12) pi))
ang2 (atran (+ ang1 (* ang11 2)))
)
(setq rad (/ (* 0.5 dis) (sin ang11))
cen (polar p1 (- ang1 pi) rad)
)
cen
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 功能: 规范弧度值
;;输入参数: 弧度
;; 返回值: 在0--pi间的弧度
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun atran (ang /)
(while (< ang 0)(setq ang (+ ang (* pi 2))))
(while (> ang (* pi 2))(setq ang (- ang (* pi 2))))
ang
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;计算弦终点函数 (圆心点 弦起点 半径 弦长 方向标记) flag=1逆时针;=2顺时针
;;返回 : 弦终点
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_xzp (cen p1 rad len flag / ang p2 ang1 csa)
(setq ang (angle cen p1))
(setq csa (/ (- (+ (* rad rad) (* rad rad)) (* len len)) (* rad rad 2.0)))
(cond
((= csa 0) (setq ang1 (* 0.5 pi)))
((= csa -1.0) (setq ang1 pi))
((= csa 1.0) (setq ang1 0))
((< (abs csa) 1.0) (setq ang1 (atan (sqrt (- (/ 1 (* csa csa)) 1.0)))))
((> (abs csa) 1.0) (setq ang1 0))
)
(if (< csa 0) (setq ang1 (- pi ang1)))
(if (= flag 1)
(setq ang (+ ang ang1))
(setq ang (- ang ang1))
)
(setq p2 (polar cen ang rad))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;圆弧上的交点判断 (起始角 终止角 圆心 需要判断的点)
;;成功 : 返回 <需要判断的点>
;;失败 : nil
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_jdpd (an1 an2 cen pp1 / an3)
(setq an3 (angle cen pp1))
(if (< an1 an2)
(progn
(if (not (and (or (> an3 an1) (equal an3 an1 0.001))
(or (< an3 an2) (equal an3 an2 0.001))))
(setq an3 nil)
)
)
(progn
(if (not (or (and (or (> an3 an1)(equal an3 an1 0.001))
(or (< an3 (* pi 2.0))(equal an3 (* pi 2.0))))
(and (or (> an3 0.0)(equal an3 0.0 0.001))
(or (< an3 an2)(equal an3 an2)))))
(setq an3 nil)
)
)
)
(if (null an3)(setq pp1 nil))
pp1
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;功能: 找出POLYLINE弧轮廓的折线点坐标集
;;输入参数:弧的弧心坐标,半径,起始角,终角,折线数量
;;返回值: 折线点坐标集
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_ctpl (cen rad ang1 ang2 / ang ang3 csa p11 p22 pp1 pp2 tmpl xsbl)
(setq xsbl (/ (getvar "viewsize") (cadr (getvar "screensize"))))
(setq xsbl (* 18.0 xsbl))
(setq pp1 (polar cen ang1 rad)
pp2 (polar cen ang2 rad)
)
(setq csa (/ (- (+ (* rad rad) (* rad rad))
(* xsbl xsbl)) (* rad rad 2.0))
)
(cond
((= csa 0) (setq ang3 (* 0.5 pi)))
((= csa -1.0) (setq ang3 pi))
((= csa 1.0) (setq ang3 0))
((< (abs csa) 1.0) (setq ang3 (atan (sqrt (- (/ 1 (* csa csa)) 1.0)))))
((> (abs csa) 1.0) (setq ang3 0))
)
(if (< csa 0) (setq ang3 (- pi ang3)))
(if (<= ang2 ang1)(setq ang2 (+ (* 2.0 pi) ang2)))
(setq ang ang1 tmpl (list pp1))
(while (< ang ang2)
(setq p11 (polar cen ang rad))
(setq ang (+ ang ang3))
(setq p22 (polar cen ang rad))
(if (< ang ang2)
(setq tmpl (cons p22 tmpl))
(if (not (equal ang ang2 0.001))(setq tmpl (cons pp2 tmpl)))
)
)
tmpl
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;功能:将线缆数据并组合成串并压入线缆内
;;输入:(配电箱编号 线路编号 实体名)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_gxl (pdx bh ent / i tmpl tmpl1 tmpl2 xlbznr)
(setq xlbznr (gxdata ent "XLBZNR" 0))
(if xlbznr
(progn
(setq tmpl (_getnB xlbznr "&"))
(setq i 0 tmpl1 nil)
(repeat (length tmpl)
(setq tmpl2 (nth i tmpl))
(cond
((= (substr tmpl2 1 6) "配电箱")(setq tmpl2 (strcat "配电箱=" pdx)))
((= (substr tmpl2 1 4) "编号")(setq tmpl2 (strcat "编号=" bh)))
)
(setq tmpl1 (cons tmpl2 tmpl1))
(setq i (1+ i))
)
(setq i 1 tmpl (nth 0 tmpl1))
(repeat (1- (length tmpl1))
(setq tmpl (strcat (nth i tmpl1) "&" tmpl))
(setq i (1+ i))
)
)
(setq tmpl (strcat "配电箱=" pdx "&编号="bh))
)
(axdata ent "XLBZNR" tmpl)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;功能:返回线端点开窗口的四点
;;输入:(起点 终点 线宽) 返回:四点点表
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_ddwp (stp nep plkd / p1 p2 p3 p4 ang)
(setq plkd (* 1.4 plkd) ang (angle nep stp))
(setq p1 (polar stp ang (* 0.5 plkd))
p1 (polar p1 (+ ang (* 0.5 pi)) (* 0.5 plkd))
p2 (polar p1 (- ang (* 0.5 pi)) plkd)
p3 (polar p2 (+ ang pi) plkd)
p4 (polar p1 (+ ang pi) plkd)
)
(list p1 p2 p3 p4)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;功能:判断点是否在pline实体之上
;;输入:(测试点 实体名)
;;返回:在实体之上T 否则,nil
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_ptpd (stp en / ang1 ang2 cen p1 p2 pp1 pp2 rad td tmpl)
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 10 (reverse (entget en)))))
(setq p1 (append p1 (list 0.0)))
(setq p2 (append p2 (list 0.0)))
(setq td (cdr (assoc 42 (entget en))))
(if (equal td 0.0 0.001)
(progn
(setq pp1 (polar stp (+ (angle p1 p2) (* 0.5 pi)) 10))
(setq pp2 (inters stp pp1 p1 p2 nil))
(if (equal stp pp2 0.001) (setq pp2 T) (setq pp2 nil))
)
(progn
(setq cen (p_cen p1 p2 td) rad (distance2p p1 cen))
(setq ang1 (angle cen p1) ang2 (angle cen p2))
(if (< td 0.0) (setq tmpl ang1 ang1 ang2 ang2 tmpl))
(if (and (equal (distance2p stp cen) rad 0.001)
(p_jdpd ang1 ang2 cen stp)
)
(setq pp2 T)
(setq pp2 nil)
)
)
)
pp2
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;功能:线端图块判断(条件:插入点距线端点距离最短者)
;;输入:(线端点 块实体选择集)
;;返回端点实体
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_xdtk (stp sse1 / dis en en1 i p1)
(setq i 0 dis (* 100 tscale) en1 (ssname sse1 0))
(repeat (sslength sse1)
(setq en (ssname sse1 i))
(setq p1 (cdr (assoc 10 (entget en))))
(if (< (distance2p p1 stp) dis)
(setq en1 en dis (distance2p p1 stp))
)
(setq i (1+ i))
)
en1
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;线缆沿块打断(块实体名)
;;返回:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_xldd (en / ang dotlst el i inspt kname l1 l2 lkname pzx retv sjwj x y z)
(setq el (entget en))
(setq kname (cdr (assoc 2 el))
inspt (cdr (assoc 10 el))
x (cdr (assoc 41 el))
y (cdr (assoc 42 el))
z (cdr (assoc 43 el))
ang (cdr (assoc 50 el))
ang (/ (* ang 180) pi)
)
(setq sjwj (strcat (XGetin "IdqMain" "IdqSys" "c:\\idq30" 1)
"\\Datcom\\Blkbdy.Idp"
)
)
;;处理后的块名,XXX_1或XXX_1--?,则块名为XXX
(setq lkname (_getnB kname "_"))
(if lkname (setq kname (car lkname)))
(setq lkname (_getnB kname "-"))
(if lkname (setq kname (car lkname)))
(setq retv (car (GetMIdp (list kname "X") sjwj)))
(if (and retv (/= retv "X"))
(progn
;;;保存块表的边界,质心的点表
;; 再根据块的插入点,X比例,Y比例,Z比例插入角度调用矩阵处理函数
;;(XMatPAll 基点 新点 X比例 Y比例 Z比例 角度 ((点1)()...))
;;返回新变换后的点对.
(setq retv (read retv) l1 (nth 0 retv) l2 (nth 1 retv) i 0)
(setq l2 (XMatPAll (list 0 0 0) inspt x y z ang l2))
(repeat (length l1)
(setq dotlst (XMatPAll (list 0 0 0) inspt x y z ang (nth i l1)))
(setq pzx (nth i l2))
(newbtrim (append dotlst (list (car dotlst))) pzx (list (cons 0 "LWPOLYLINE,LINE") (cons 8 "LIN*,RLIN*")))
(setq i (1+ i))
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;生成弧线pline线并跨接、断线函数
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_pla (stp nep pdx bh / ang1 ang2 ange angs bcen brad cen dis
edp el en ent ent1 i ii int intenl intl lst p1 p2 osold
pp1 pp2 rad sbe1 sbe2 sse1 sse2 ssen td tmpl plxx)
(if (and pdx bh)
(progn
(setq xlsjl (getxl1))
(setq pdx (nth 0 xlsjl) bh (nth 1 xlsjl) k_k (nth 2 xlsjl)
d_d (nth 3 xlsjl)dxif (nth 4 xlsjl)
d_d1(nth 5 xlsjl)osif (nth 6 xlsjl)
)
)
(progn
(setq xlsjl (getxl3))
(setq pdx nil bh nil k_k (nth 0 xlsjl) d_d (nth 1 xlsjl)
dxif (nth 2 xlsjl) d_d1(nth 3 xlsjl)osif (nth 4 xlsjl)
)
)
)
(setq edp (XArcdg stp nep))
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(if (= osif 1)(if (setq ent (C_sbos edp)) (setq edp (C_gjpt ent edp))))
(command "_.arc" stp edp nep)
(setq en (entlast) el (entget en))
(setq bcen (cdr (assoc 10 el)) brad (cdr (assoc 40 el))
angs (cdr (assoc 50 el)) ange (cdr (assoc 51 el))
)
(setq lst (p_ctpl bcen brad angs ange))
(command "_.pedit" en "_y" "_w" plkd "")
(setq ent (entlast))
(setq plxx (strcat "PLXX" (cdr (assoc 5 (entget ent)))))
(axdata ent plxx plxx)
(if (and pdx bh)(p_gxl pdx bh ent))
(setq sse1 (ssget "cp" (p_ddwp stp nep plkd)
'((0 . "LWPOLYLINE")(8 . "LIN*")))
)
(setq ssen (ssget "f" lst
'((0 . "LWPOLYLINE,LINE")(8 . "LIN*,RLIN*"))))
(if ssen ;;;断线处理
(progn
(if sse1
(progn
(setq i 0)
(repeat (sslength sse1)
(setq ent1 (ssname sse1 i))
(if (and pdx bh)
(if (= (cdr (assoc 8 (entget ent1))) layna)
(if (p_ptpd stp ent1)(p_gxl pdx bh ent1))
)
)
(setq i (1+ i))
)
)
)
(setq sse1 (ssget "cp" (p_ddwp nep stp plkd)
'((0 . "LWPOLYLINE")(8 . "LIN*")))
)
(if sse1
(progn
(setq i 0)
(repeat (sslength sse1)
(setq ent1 (ssname sse1 i))
(if (and pdx bh)
(if (= (cdr (assoc 8 (entget ent1))) layna)
(if (p_ptpd nep ent1)(p_gxl pdx bh ent1))
)
)
(setq i (1+ i))
)
)
)
(if (= dxif 1)
(progn
(ssdel ent ssen)
(setq i 0 intl nil intenl nil)
(repeat (sslength ssen)
(setq en (ssname ssen i))
(setq tmpl (XintEt ent en 3))
(cond
((= (length tmpl) 1)
(setq tmpl (list (car tmpl) en))
(setq intenl (cons tmpl intenl))
)
((= (length tmpl) 2)
(setq intl (append tmpl intl))
)
)
(setq i (1+ i))
)
(if intenl ;;处理只有一个交点的实体
(progn
(setq i 0)
(repeat (length intenl)
(setq tmpl (nth i intenl))
(setq en (cadr tmpl) int (car tmpl))
(if (not (or (equal int stp 0.001)(equal int nep 0.001)))
(progn
(cond
((= (cdr (assoc 0 (entget en))) "LINE")
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 11 (entget en))))
(setq pp1 (polar int (angle p1 p2) (/ (* d_d1 tscale) 2)))
(setq pp2 (polar int (angle p2 p1) (/ (* d_d1 tscale) 2)))
(newbk en pp1 pp2)
)
((= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 10 (reverse (entget en)))))
(setq p1 (append p1 (list 0.0)))
(setq p2 (append p2 (list 0.0)))
(setq td (cdr (assoc 42 (entget en))))
(if (equal td 0.0 0.001)
(progn
(setq pp1 (polar int (angle p1 p2) (/ (* d_d1 tscale) 2)))
(setq pp2 (polar int (angle p2 p1) (/ (* d_d1 tscale) 2)))
(newbk en pp1 pp2)
)
(progn
(setq cen (p_cen p1 p2 td))
(setq rad (distance2p int cen))
(setq dis (/ (* d_d1 tscale) 2))
(setq pp1 (p_xzp cen int rad dis 1))
(setq pp2 (p_xzp cen int rad dis 2))
(newbk en pp1 pp2)
)
)
)
)
))
(setq i (1+ i))
)
)
)
(if intl
(progn
(setq i 0)
(repeat (length intl)
(setq int (nth i intl))
(if (not (or (equal int stp 0.001)(equal int nep 0.001)))
(progn
(setq sse1 (ssget "c" (polar int (* pi 0.25) plkd)
(polar int (* pi 1.25) plkd)
'((0 . "LWPOLYLINE,LINE")(8 . "LIN*,RLIN*")))
)
(if sse1
(progn
(ssdel ent sse1)
(setq ii 0)
(repeat (sslength sse1)
(setq en (ssname sse1 ii))
(cond
((= (cdr (assoc 0 (entget en))) "LINE")
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 11 (entget en))))
(if (equal (inters int int p1 p2) int 0.001)
(progn
(setq pp1 (polar int (angle p1 p2) (/ (* d_d1 tscale) 2)))
(setq pp2 (polar int (angle p2 p1) (/ (* d_d1 tscale) 2)))
(newbk en pp1 pp2)
)
)
)
((= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 10 (reverse (entget en)))))
(setq p1 (append p1 (list 0.0)))
(setq p2 (append p2 (list 0.0)))
(setq td (cdr (assoc 42 (entget en))))
(if (equal td 0.0 0.001)
(progn
(if (equal (inters int int p1 p2) int 0.001)
(progn
(setq pp1 (polar int (angle p1 p2) (/ (* d_d1 tscale) 2)))
(setq pp2 (polar int (angle p2 p1) (/ (* d_d1 tscale) 2)))
(newbk en pp1 pp2)
)
)
)
(progn
(setq cen (p_cen p1 p2 td))
(setq ang1 (angle cen p1) ang2 (angle cen p2))
(if (< td 0.0) (setq tmpl ang1 ang1 ang2 ang2 tmpl))
(setq pp1 (p_jdpd ang1 ang2 cen int))
(if pp1
(progn
(setq rad (distance2p int cen))
(setq dis (/ (* d_d1 tscale) 2))
(setq pp1 (p_xzp cen int rad dis 1))
(setq pp2 (p_xzp cen int rad dis 2))
(newbk en pp1 pp2)
)
)
)
)
)
)
(setq ii (1+ ii))
)
)
)
))
(setq i (1+ i))
)
)
)
));;断线判断是否
)
)
(if (= k_k 1)
(progn
(if (setq sse1 (ssget "c" (polar stp (* pi 0.25) (* 5 tscale))
(polar stp (* pi 1.25) (* 5 tscale))
'((0 . "insert") (8 . "?PM*"))))
(setq sbe1 (p_xdtk stp sse1))
(setq sbe1 nil)
)
(if (and sbe1 pdx bh) (axdata sbe1 "HLXX" (strcat pdx "&" bh)))
(if sbe1 (p_xldd sbe1))
(if (setq sse2 (ssget "c" (polar nep (* pi 0.25) (* 5 tscale))
(polar nep (* pi 1.25) (* 5 tscale))
'((0 . "insert") (8 . "?PM*"))))
(setq sbe2 (p_xdtk nep sse2))
(setq sbe2 nil)
)
(if (and sbe2 pdx bh)(axdata sbe2 "HLXX" (strcat pdx "&" bh)))
(if sbe2 (p_xldd sbe2))
(setq ssen (ssget "f" lst
'((0 . "INSERT") (8 . "?PM*"))))
(if ssen
(progn
(if sbe1 (ssdel sbe1 ssen))
(if sbe2 (ssdel sbe2 ssen))
(setq i 0 intl nil)
(repeat (sslength ssen)
(setq en (ssname ssen i))
(setq pp1 (cdr (assoc 10 (entget en))))
(setq int (polar bcen (angle bcen pp1) brad))
(if int (setq intl (cons int intl)))
(setq i (1+ i))
)
(if intl
(progn
(setq i 0)
(repeat (length intl)
(setq int (nth i intl))
(setq sse1 (ssget "c" (polar int (* pi 0.25) plkd)
(polar int (* pi 1.25) plkd)
'((0 . "LWPOLYLINE")(8 . "LIN*,RLIN*")))
)
(if sse1
(progn
(setq ii 0)
(repeat (sslength sse1)
(setq en (ssname sse1 ii))
(setq td (cdr (assoc 42 (entget en))))
(if (not (equal td 0.0 0.001))
(progn
(setq dis (/ (* d_d tscale) 2))
(setq pp1 (p_xzp bcen int brad dis 1))
(setq pp2 (p_xzp bcen int brad dis 2))
(newbk en pp1 pp2)
)
)
(setq ii (1+ ii))
)
)
)
(setq i (1+ i))
)
)
)
)
)
)
(progn
(if (setq sse1 (ssget "c" (polar stp (* pi 0.25) (* 5 tscale))
(polar stp (* pi 1.25) (* 5 tscale))
'((0 . "insert") (8 . "?PM*"))))
(setq sbe1 (p_xdtk stp sse1))
(setq sbe1 nil)
)
(if (and sbe1 pdx bh) (axdata sbe1 "HLXX" (strcat pdx "&" bh)))
(if (setq sse2 (ssget "c" (polar nep (* pi 0.25) (* 5 tscale))
(polar nep (* pi 1.25) (* 5 tscale))
'((0 . "insert") (8 . "?PM*"))))
(setq sbe2 (p_xdtk nep sse2))
(setq sbe2 nil)
)
(if (and sbe2 pdx bh)(axdata sbe2 "HLXX" (strcat pdx "&" bh)))
(setq ssen (ssget "f" lst
'((0 . "INSERT") (8 . "?PM*"))))
(if ssen
(progn
(setq i 0 intl nil)
(repeat (sslength ssen)
(setq en (ssname ssen i))
(p_xldd en)
(if (and pdx bh) (axdata en "HLXX" (strcat pdx "&" bh)))
(setq i (1+ i))
)
)
)
)
)
(setvar "osmode" oldos)
nep
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;生成直线pline线并跨接、断线函数
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_pll (stp nep pdx bh / ang1 ang2 cen dis en ent ent1 i ii int
intenl intl p1 p2 pp1 pp2 rad sbe1 sbe2 sse1 sse2 ssen
td tmpl plxx oldos)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "_.pline" stp "_w" plkd plkd nep "")
(setq ent (entlast))
(setq plxx (strcat "PLXX" (cdr (assoc 5 (entget ent)))))
(axdata ent plxx plxx)
(if (and pdx bh)(p_gxl pdx bh ent))
(setq sse1 (ssget "cp" (p_ddwp stp nep plkd)
'((0 . "LWPOLYLINE")(8 . "LIN*")))
)
(setq ssen (ssget "f" (list stp nep)
'((0 . "LWPOLYLINE,LINE")(8 . "LIN*,RLIN*"))))
(if ssen ;;;断线处理
(progn
(if sse1
(progn
(setq i 0)
(repeat (sslength sse1)
(setq ent1 (ssname sse1 i))
(if (and pdx bh)
(if (= (cdr (assoc 8 (entget ent1))) layna)
(if (p_ptpd stp ent1)(p_gxl pdx bh ent1))
)
)
(setq i (1+ i))
)
)
)
(setq sse1 (ssget "cp" (p_ddwp nep stp plkd)
'((0 . "LWPOLYLINE")(8 . "LIN*")))
)
(if sse1
(progn
(setq i 0)
(repeat (sslength sse1)
(setq ent1 (ssname sse1 i))
(if (and pdx bh)
(if (= (cdr (assoc 8 (entget ent1))) layna)
(if (p_ptpd nep ent1)(p_gxl pdx bh ent1))
)
)
(setq i (1+ i))
)
)
)
(if (= dxif 1)
(progn
(ssdel ent ssen)
(setq i 0 intl nil intenl nil)
(repeat (sslength ssen)
(setq en (ssname ssen i))
(setq tmpl (XintEt ent en 3))
(cond
((= (length tmpl) 1)
(setq tmpl (list (car tmpl) en))
(setq intenl (cons tmpl intenl))
)
((= (length tmpl) 2)
(setq intl (append tmpl intl))
)
)
(setq i (1+ i))
)
(if intenl ;;处理只有一个交点的实体
(progn
(setq i 0)
(repeat (length intenl)
(setq tmpl (nth i intenl))
(setq en (cadr tmpl) int (car tmpl))
(if (not (or (equal int stp 0.001)(equal int nep 0.001)))
(progn
(cond
((= (cdr (assoc 0 (entget en))) "LINE")
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 11 (entget en))))
(setq pp1 (polar int (angle p1 p2) (/ (* d_d1 tscale) 2)))
(setq pp2 (polar int (angle p2 p1) (/ (* d_d1 tscale) 2)))
(newbk en pp1 pp2)
)
((= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 10 (reverse (entget en)))))
(setq p1 (append p1 (list 0.0)))
(setq p2 (append p2 (list 0.0)))
(setq td (cdr (assoc 42 (entget en))))
(if (equal td 0.0 0.001)
(progn
(setq pp1 (polar int (angle p1 p2) (/ (* d_d1 tscale) 2)))
(setq pp2 (polar int (angle p2 p1) (/ (* d_d1 tscale) 2)))
(newbk en pp1 pp2)
)
(progn
(setq cen (p_cen p1 p2 td))
(setq rad (distance2p int cen))
(setq dis (/ (* d_d1 tscale) 2))
(setq pp1 (p_xzp cen int rad dis 1))
(setq pp2 (p_xzp cen int rad dis 2))
(newbk en pp1 pp2)
)
)
)
)
))
(setq i (1+ i))
)
)
)
(if intl
(progn
(setq i 0)
(repeat (length intl)
(setq int (nth i intl))
(if (not (or (equal int stp 0.001)(equal int nep 0.001)))
(progn
(setq sse1 (ssget "c" (polar int (* pi 0.25) plkd)
(polar int (* pi 1.25) plkd)
'((0 . "LWPOLYLINE,LINE")(8 . "LIN*,RLIN*")))
)
(if sse1
(progn
(ssdel ent sse1)
(setq ii 0)
(repeat (sslength sse1)
(setq en (ssname sse1 ii))
(cond
((= (cdr (assoc 0 (entget en))) "LINE")
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 11 (entget en))))
(if (equal (inters int int p1 p2) int 0.001)
(progn
(setq pp1 (polar int (angle p1 p2) (/ (* d_d1 tscale) 2)))
(setq pp2 (polar int (angle p2 p1) (/ (* d_d1 tscale) 2)))
(newbk en pp1 pp2)
)
)
)
((= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 10 (reverse (entget en)))))
(setq p1 (append p1 (list 0.0)))
(setq p2 (append p2 (list 0.0)))
(setq td (cdr (assoc 42 (entget en))))
(if (equal td 0.0 0.001)
(progn
(if (equal (inters int int p1 p2) int 0.001)
(progn
(setq pp1 (polar int (angle p1 p2) (/ (* d_d1 tscale) 2)))
(setq pp2 (polar int (angle p2 p1) (/ (* d_d1 tscale) 2)))
(newbk en pp1 pp2)
)
)
)
(progn
(setq cen (p_cen p1 p2 td))
(setq ang1 (angle cen p1) ang2 (angle cen p2))
(if (< td 0.0) (setq tmpl ang1 ang1 ang2 ang2 tmpl))
(setq pp1 (p_jdpd ang1 ang2 cen int))
(if pp1
(progn
(setq rad (distance2p int cen))
(setq dis (/ (* d_d1 tscale) 2))
(setq pp1 (p_xzp cen int rad dis 1))
(setq pp2 (p_xzp cen int rad dis 2))
(newbk en pp1 pp2)
)
)
)
)
)
)
(setq ii (1+ ii))
)
)
)
))
(setq i (1+ i))
)
)
)
));;断线判断是否
)
)
(if (= k_k 1)
(progn
(if (setq sse1 (ssget "c" (polar stp (* pi 0.25) (* 5 tscale))
(polar stp (* pi 1.25) (* 5 tscale))
'((0 . "insert") (8 . "?PM*"))))
(setq sbe1 (p_xdtk stp sse1))
(setq sbe1 nil)
)
(if (and sbe1 pdx bh) (axdata sbe1 "HLXX" (strcat pdx "&" bh)))
(if sbe1 (p_xldd sbe1))
(if (setq sse2 (ssget "c" (polar nep (* pi 0.25) (* 5 tscale))
(polar nep (* pi 1.25) (* 5 tscale))
'((0 . "insert") (8 . "?PM*"))))
(setq sbe2 (p_xdtk nep sse2))
(setq sbe2 nil)
)
(if (and sbe2 pdx bh)(axdata sbe2 "HLXX" (strcat pdx "&" bh)))
(if sbe2 (p_xldd sbe2))
(setq ssen (ssget "f" (list stp nep)
'((0 . "INSERT") (8 . "?PM*"))))
(if ssen
(progn
(if sbe1 (ssdel sbe1 ssen))
(if sbe2 (ssdel sbe2 ssen))
(setq p1 (cdr (assoc 10 (entget ent))))
(setq p2 (cdr (assoc 10 (reverse (entget ent)))))
(setq p1 (append p1 (list 0.0)))
(setq p2 (append p2 (list 0.0)))
(setq i 0 intl nil)
(repeat (sslength ssen)
(setq en (ssname ssen i))
(setq pp1 (cdr (assoc 10 (entget en))))
(setq pp2 (polar pp1 (+ (* pi 0.5) (angle p1 p2)) 10))
(setq int (inters pp1 pp2 p1 p2 nil))
(if int (setq intl (cons int intl)))
(setq i (1+ i))
)
(if intl
(progn
(setq i 0)
(repeat (length intl)
(setq int (nth i intl))
(setq sse1 (ssget "c" (polar int (* pi 0.25) plkd)
(polar int (* pi 1.25) plkd)
'((0 . "LWPOLYLINE")(8 . "LIN*,RLIN*")))
)
(if sse1
(progn
(setq ii 0)
(repeat (sslength sse1)
(setq en (ssname sse1 ii))
(setq td (cdr (assoc 42 (entget en))))
(if (equal td 0.0 0.001)
(progn
(setq pp1 (polar int (angle p1 p2) (/ (* d_d tscale) 2)))
(setq pp2 (polar int (angle p2 p1) (/ (* d_d tscale) 2)))
(newbk en pp1 pp2)
)
)
(setq ii (1+ ii))
)
)
)
(setq i (1+ i))
)
)
)
)
)
)
(progn
(setq ssen (ssget "f" (list
(polar stp (angle nep stp) (* 2.5 tscale))
(polar nep (angle stp nep) (* 2.5 tscale))
)
'((0 . "INSERT") (8 . "?PM*"))))
(if ssen
(progn
(setq i 0 intl nil)
(repeat (sslength ssen)
(setq en (ssname ssen i))
(p_xldd en)
(if (and pdx bh)(axdata en "HLXX" (strcat pdx "&" bh)))
(setq i (1+ i))
)
)
)
)
)
(setvar "osmode" oldos)
nep
)
;;;C_plal主函数
(if (= flag 1)
(p_pll stp nep pdx bh)
(setq nep (p_pla stp nep pdx bh))
)
nep
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;块内关键点捕捉公用函数
;;输入:1---块实体名;
;; 2---鼠标当前点;
;;返回:成功--离当前点最近的一个关键点,失败--返回输入点
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C_Gjpt (en stp / I tmpl2 nep p1 p2 pp1 pp2 rad tmpl tmpl1 ang)
(if (= (cdr(assoc 0 (entget en))) "INSERT")
(progn
(setq tmpl2 (cdr (assoc 2 (entget en))))
(if (_getnB tmpl2 "--")(setq tmpl2 (car (_getnB tmpl2 "--"))))
(if (_getnB tmpl2 "_")(setq tmpl2 (car (_getnB tmpl2 "_"))))
(setq tmpl (xgetps (strcat "Lnwzdy\\" tmpl2 "\\XY")
""
(strcat (XGetin "IdqMain" "IdqSys" "c:\\idq30" 1)
"\\datcom\\Sbwzsj.Idp")
)
)
(if (/= tmpl "")
(progn
(setq tmpl (_getnB tmpl "&"))
(setq i 0 tmpl1 nil)
(while (< i (length tmpl))
(setq p1 (atof (nth i tmpl)) p2 (atof (nth (1+ i) tmpl)))
(setq p1 (list p1 p2 0.0))
(setq tmpl1 (cons p1 tmpl1))
(setq i (+ i 2))
)
(setq p1 (cdr (assoc 10 (entget en))))
(setq pp1 (cdr (assoc 41 (entget en))))
(setq pp2 (cdr (assoc 42 (entget en))))
(setq ang (cdr(assoc 50 (entget en))))
(setq i 0 rad nil)
(repeat (length tmpl1)
(setq p2 (nth i tmpl1))
(if (equal p2 '(0 0 0) 0.001)
(setq p2 p1)
(progn
(setq p2 (list (+ (* (car p2) pp1) (car p1))
(+ (* (cadr p2)pp2) (cadr p1))0.0)
)
(setq p2 (polar p1 (+ ang (angle p1 p2)) (distance2p p1 p2)))
)
)
(if (null rad)(setq rad (distance2p stp p2) nep p2))
(if (< (distance2p stp p2) rad)
(setq rad (distance2p stp p2) nep p2)
)
(setq i (1+ i))
)
)
(setq nep (cdr (assoc 10 (entget en))))
)
)
(progn
(setq nep (osnap stp "end"))
(if (null nep)(setq nep stp))
)
)
nep
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;由输入点捕捉设备公用函数
;;输入:1---点
;;返回:成功--返回设备实体名,失败--nil
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C_sbos (stp / en tmpl p1 p2 ssen)
(setq en nil)
(setq tmpl (/ (* (getvar "aperture")
(getvar "viewsize")
)
(cadr (getvar "screensize"))
)
)
(setq p2 (list (+ (car stp) tmpl) (+ (cadr stp) tmpl) 0))
(setq p1 (list (- (car stp) tmpl) (- (cadr stp) tmpl) 0))
(setq ssen (ssget "c" p1 p2 (list '(0 . "INSERT")(cons 8 "?PM*"))))
(if ssen
(setq en (ssname ssen 0))
(progn
(setq ssen (ssget "c" p1 p2 '((0 . "LWPOLYLINE,LINE")(8 . "LIN*,RLIN*"))))
(if ssen(setq en (ssname ssen 0)))
)
)
en
)
;;;;;------------------------------------------------------------------
;;;;;公用函数结束
;;;;;------------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;起点提示函数
;;返回 :成功:起点坐标
;; 失败:nil
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun d_stp (/ fh stp ts en)
(setq FH T)
(while FH
(princ "\n状态: ")
(if (= k_kk 1)
(princ " 直线")
(princ " 弧")
)
(setq ts (strcat "\n请点取线缆起点<回车结束>:"))
(setq stp (getpoint ts))
(setq xlsjl (getxl3))
(setq k_k (nth 0 xlsjl) d_d (nth 1 xlsjl)
dxif (nth 2 xlsjl)d_d1(nth 3 xlsjl) osif (nth 4 xlsjl)
)
(if (<= d_d 0.0)(setq k_k 0))
(if (<= d_d1 0.0)(setq dxif 0))
(cond
((= stp nil) (setq fh nil))
(T
(if (= osif 1)(if (setq en (C_sbos stp))(setq stp (C_gjpt en stp))))
(setq fh nil)
)
)
)
stp
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;第二点提示函数1(三点)
;;返回 :成功:起点坐标
;; 失败:nil
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun d_nep1 (/ fh nep ts en)
(setq FH T)
(while FH
(princ "\n状态: ")
(if (= k_kk 1)
(progn
(initget "A a U u")
(princ " 直线")
(setq ts (strcat "\n弧A/回退U/下一点<回车结束>:"))
)
(progn
(princ " 弧")
(initget "U u L l")
(setq ts (strcat "\n直线L/回退U/第二点<回车结束>:"))
)
)
(setq nep (getpoint (car ptlst) ts))
(setq xlsjl (getxl3))
(setq k_k (nth 0 xlsjl) d_d (nth 1 xlsjl)
dxif (nth 2 xlsjl)d_d1(nth 3 xlsjl) osif (nth 4 xlsjl)
)
(if (<= d_d 0.0)(setq k_k 0))
(if (<= d_d1 0.0)(setq dxif 0))
(cond
((or (= nep "a") (= nep "A"))
(setq k_kk 0)
(setq nep nil)
)
((or (= nep "l") (= nep "L"))
(setq k_kk 1 nep nil)
)
((or (= nep "u") (= nep "U"))
(if (= (length ptlst) 1)
(progn
(princ "\n已回退到起点!")
(setq FH nil nep 0)
)
(progn
(command "_.U")
(setq ptlst (cdr ptlst))
(if (= (length ptlst) 1)(setq fh nil nep 0))
)
)
)
((= nep nil) (setq fh nil))
(T
(if (= osif 1)(if (setq en (C_sbos nep))(setq nep (C_gjpt en nep))))
(setq fh nil)
)
)
)
(if nep
(list nep)
nil
)
)
;;;电力电缆主函数
(if (= (ISFUNRUN) nil)(exit))
(_inidwg)
(princ "\n*电力电缆*=Dldl")
(setvar "cmdecho" 0)
(command "_.undo" "_begin")
(setq ucmark (getvar "worlducs"))
(if (= ucmark 0)
(progn
(setq ucs_fo (getvar "ucsfollow"))
(if (= ucs_fo 1)
(setvar "ucsfollow" 0)
)
(command "_.ucs" "_world")
)
)
(setq tscale (atof (xrddic "Tabscale" "100")))
(if (= tscale 0.0) (setq tscale 1.0))
(setq plkd (atof (XGetps "Pmdata\\DxDlg\\LineWidth" "0.3")))
(setq plkd (* plkd tscale))
(setvar "aperture" 5)
(setvar "blipmode" 0)
(command "_Layer" "_m" "LINDL" "c" 4 "" "")
(command "_.color" "4")
(setvar "celtscale" (/ 1000.0 (getvar "ltscale")))
(command "_.linetype" "_s" "CONTINUOUS" "")
(command "_.undo" "_end")
(setq k_kk (atoi (XGetps "Pmdata\\Dldl\\k_kk" "1")))
(setq stp 0 pdx nil bh nil layna "LINDL")
(Showxl3)
(while stp
(setq stp (d_stp))
(if stp
(progn
(setq ptlst (list stp))
(setq nep 1)
(while nep
(setq nep (d_nep1))
(cond
((null nep) (setq stp nil))
((= (car nep) 0) (setq nep nil))
(T
(setq nep (car nep))
(command "_.undo" "_begin")
(setq nep (C_plal (car ptlst) nep pdx bh layna
plkd d_d d_d1 k_k dxif tscale k_kk osif)
)
(setq ptlst (cons nep ptlst))
(command "_.undo" "_end")
)
)
)
)
)
)
(Hidexl3)
(if (= ucmark 0)
(command "_.ucs" "_prev")
)
(XSetps "Pmdata\\Dldl\\k_kk" (itoa k_kk))
(_resdwg)
(setq *error* errold)
(princ)
)
(Setfunhelp "C:Dldl" "Idq30.hlp" "ID_BDldl") |
|