[LISP程序]：回路替换-名称：C:HLTH

crtrccrt · 发表于 2006-2-12 22:33:00

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;=================================主程序开始=================================
;;名称：C:HLTH
;;功能：回路替换
;;输入：无
;;返回：无
(defun C:HLTH(/ tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo
h_sh1 h_XZHL h_WZYZ h_HLHZ h_LXDD h_WZPD h_LXXZ h_mxwz h_inwi
h_comp C_zoom C_ssgl C_xyzb C_ldel C_movt C_movk C_hlin C_slin
s_px)
(setq olderr *error*)
;;=================================子函数开始=================================
;;名称：*error*(错误处理函数)
;;功能：当程序发生错误或用户中断时，平静地退出，并还原状态。
;;输入：无
;;返回：无
(defun *error* (msg / each)
(if (= fan 1)(command "_.undo" "_end"))
(if (= fan 1)(command "_.undo" ""))
(if (= ucmark 0) (command "_.ucs" "_prev"))
(xsetin "Hlklib" "Hlkpara" o_para 1)
(xsetin "Hlklib" "RetHlkMes" o_mes 1)
(xsetin "Hlklib" "Hlkjj" o_jj 1)
(if(= lxfs 1)
(progn(setq i 0)(repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i))))
)
(setq dqwn (XScjx))
(if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw)))
(foreach each
'(tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo h_sh1 h_xzhl
h_wzyz h_hlhz h_lxdd h_wzpd h_lxxz h_mxwz h_inwi h_comp C_zoom C_ssgl C_xyzb
C_ldel C_movt C_movk C_hlin C_slin point1 point2 i ename point3 point4 ss
elist point5 point6 biao ylist plist l xlist n nylist s_px yy list1 list2 a b
emx p1 p2 p3 pd1 pd2 pc mxwzt wzt npd1 npd2 es sins first fxhsf hszf pmxd1
pmxd2 fxhs hsz wzyz ssfah fah pjd fx sshl hlsm kd hll smx mxt len1 ii iii mxmin
mxmax i4 pcl e pcxl pcyl pcc xzt len2 pds hljj lxl pde hs smxal ls dqw1 wzpdt
dist data1 data2 sm2 zdist pdmx2 mxkd lll1 ph1 ph2 ttt1 hlxzl lll2 ttt2 ph3 ph4
slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj jjn hldata smov zxj
ysj zxjn ysjn mylist ess fan name laye yanse hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 pjd2
fx2 kd2 hlsm2 hlxzl2 pjdn1 pjd1n pjd2n pme smov1 smov2 pmds1 pmds1n pmds2 pmds2n
pmde1 pmde2 jj1 jj2 sshl2 ss1 ss2 ss3 ylist1 ylist2 plist1 plist2 xlist1 xlist2
ess1 ess2 point shu xzb)
(set each nil)
)
(setq each nil)
(setq *error* olderr olderr nil)
(_resdwg)
(princ)
)
;;=================================子函数开始=================================
;;名称：C_zoom
;;功能：判断是否zoom
;;输入：mylist-订货图的角表 zxj-视区左下角 ysj-视区右上角
;;返回：无
(defun C_zoom(mylist zxjn ysjn / point1 point2)
(setq point1(car mylist))
(setq point2(last mylist))
(if(or(>(car zxjn)(car point2))(<(car ysjn)(car point1))
(>(cadr zxjn)(cadr point1))(<(cadr ysjn)(cadr point2))
)
(command "_.ZOOM" "_w" point1 point2)
)
)
;;=================================子函数开始=================================
;;名称：C_ssgl
;;功能：过滤选择集
;;输入：ss1-选择集1 ss2-选择集2
;;返回：ss1
(defun C_ssgl(ss1 ss2 / i ename)
(setq i 0)
(repeat(sslength ss2)
(setq ename (ssname ss2 i))
(ssdel ename ss1)
(setq i (+ i 1))
)
ss1
)
;;=================================子函数开始=================================
;;名称：C_xyzb
;;功能：得到所选回路所有横线的Y坐标点集
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长
;;返回：ylist-所选回路所有横线的Y坐标表
(defun C_xyzb(mylist pjd kd / point1 point2 point3 point4 i ss ename elist
point5 point6 biao ylist)
(setq ylist '())
(setq point1(car mylist))
(setq point2(last mylist))
(setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2)))
(setq point4(list(+(car point3)kd)(cadr point1)(last point1)))
(setq ss (ssget "W" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3))))
(setq i 0)
(repeat (sslength ss)
(setq ename (ssname ss i))
(setq elist (entget ename))
(setq point5(cdr(assoc 10 elist)))
(setq point6(cdr(assoc 11 elist)))
(if (equal(cadr point5)(cadr point6)0.1)
(progn
(setq biao(member (cadr point5) ylist))
(if (not biao)
(setq ylist(cons (cadr point5) ylist))
)
)
)
(setq i (+ i 1))
)
ylist
)
;;=================================子函数开始=================================
;;名称：C_ldel
;;功能：得到所选回路列的左上角和右下角
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 sshl-回路选择集
;;返回：plist-点表(所选回路列的右上角、订货图的右下角和所选回路列的选择集)
(defun C_ldel(mylist pjd kd sshl / point1 point2 point3 point4 point5 ss plist)
(setq point1(car mylist))
(setq point2(last mylist))
(setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2)))
(setq point4(list(+(car pjd)(/ kd 2))(cadr point1)(last point2)))
(setq ss(ssget "w" point3 point4))
(setq ss(C_ssgl ss sshl))
(setq point5(list(car point4)(cadr point2)(last point2)))
(setq plist (list point5 point1 ss))
)
;;=================================子函数开始=================================
;;名称：C_movt
;;功能：copy回路并移动表格(从当前图中copy或move)
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度
;; sshln-替换回路 pjdf-替换回路的基点 pjd-被替回路的基点 smov-回路选择集
;; a-为0时拷贝,为1时移动,为2时插入
;;返回：xlist-新回路列的x坐标
(defun C_movt(plist kd kdn sshln pjdf pjdn smov a / point1 point2 l point3 point4 xlist ss)
(setq point1(car plist))
(setq point2(cadr plist))
(if(or(= a 0)(= a 1))
(progn
(setq l(- kd kdn))
(setq point3(list(-(car point1)l)(cadr point1)(last point1)))
(setq ss(ssget "w" point1 point2))
(if (= a 0)
(command "_.copy" sshln "" pjdf pjdn)
(command "_.move" sshln "" pjdf pjdn)
)
(if smov
(progn
(command "_.move" smov "" point1 point3)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point1 point3)
(setq xlist(list(-(car point1)kd)(car point3)))
)
(progn
(setq point3(list(-(car point1)kd)(cadr point1)(last point1)))
(setq point4(list(+(car point3)kdn)(cadr point3)(last point3)))
(setq ss (ssget "w" point3 point2))
(command "_.copy" sshln "" pjdf pjdn)
(if smov
(progn
(command "_.move" smov "" point3 point4)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point3 point4)
(setq xlist(list(car point3)(car point4)))
)
)
xlist
)
;;=================================子函数开始=================================
;;名称：C_movk
;;功能：copy回路并移动表格(从图库中取)
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度
;; pjdn-替换回路 fx-回路方向 dist、data1、data2、sm2-调回路库的参数 smov-回路选择集
;; a-为时替换回路,为2时插入回路
;;返回：xlist-新回路列的两个x坐标
(defun C_movk(plist kd kdn pjdn fx dist data1 data2 sm2 smov a / point1 point2 l point3
point4 xlist ss)
(setq point1(car plist))
(setq point2(cadr plist))
(if (= a 1)
(progn
(setq l(- kd kdn))
(setq point3(list(-(car point1)l)(cadr point1)(last point1)))
(setq ss(ssget "w" point1 point2))
(h_hlhz pjdn fx dist data1 data2 sm2)
(if smov
(progn
(command "_.move" smov "" point1 point3)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point1 point3)
(setq xlist(list(-(car point1)kd)(car point3)))
)
(progn
(setq point3(list(-(car point1)kd)(cadr point1)(last point1)))
(setq point4(list(+(car point3)kdn)(cadr point3)(last point3)))
(setq ss (ssget "w" point3 point2))
(h_hlhz pjdn fx dist data1 data2 sm2)
(if smov
(progn
(command "_.move" smov "" point3 point4)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point3 point4)
(setq xlist(list(car point3)(car point4)))
)
)
xlist
)
;;=================================子函数开始=================================
;;名称：C_hlin
;;功能：画横线
;;输入：xlist-新订货图的x坐标表 ylist-所选订货图所有横线的Y坐标表 hlsm-回路数目
;;返回：无
(defun C_hlin(xlist ylist hlsm / point1 point2 i l n)
(setq i 0)
(setq l(/(abs(-(car xlist)(last xlist)))hlsm))
(repeat (length ylist)
(setq n 0)
(repeat hlsm
(setq point1(list(+(car xlist)(* l n))(nth i ylist)0.0))
(setq point2(list(+(car xlist)(* l (+ n 1)))(nth i ylist)0.0))
(command "_.line" point1 point2 "")
(setq n (+ n 1))
)
(setq i (+ i 1))
)
)
;;=================================子函数开始=================================
;;名称：s_px
;;功能：排序(从大到小)
;;输入：ylist-所选订货图所有横线的Y坐标表
;;返回：nylist
(defun s_px(ylist / i nylist yy list1 list2)
(setq nylist '())
(while (/= (length ylist) 0)
(setq i 1)
(setq yy (nth 0 ylist))
(repeat (-(length ylist)1)
(if (> yy (nth i ylist))
(setq yy (nth i ylist))
)
(setq i (+ i 1))
)
(setq nylist (cons yy nylist))
(setq list1 (cdr (member yy ylist)))
(setq list2 (cdr (member yy (reverse ylist))))
(setq ylist (append list1 list2))
)
nylist
)
;;=================================子函数开始=================================
;;名称：C_slin
;;功能：画竖线
;;输入：xzb-x坐标 ylist-所选订货图所有横线的Y坐标表
;;返回：无
(defun C_slin(xzb ylist / nylist point1 point2 i)
(setq i 0)
(setq nylist(s_px ylist))
(repeat (-(length nylist)1)
(setq point1(list xzb (nth i nylist)))
(setq point2(list xzb (nth (+ i 1) nylist)))
(command "_.line" point1 point2 "")
(setq i (+ i 1))
)
)
;;=================================子函数开始=================================
;;名称：h_comp
;;功能：计算两值的差(用于排序)
;;输入：a、b
;;返回：两值的差
(defun h_comp (a b)
(- a b)
)
;;=================================子函数开始=================================
;;名称: h_inwi
;;功能: 判断p1是否在p2 p3组成的窗口内
;;输入: p1 p2 p3
;;返回: 0-在窗口内、1-在窗口外、nil-边界上
(defun h_inwi (p1 p2 p3)
(cond
((and(< (car p1) (- (max (car p2) (car p3)) tscale))
(> (car p1) (+ (min (car p2) (car p3)) tscale))
(< (cadr p1) (- (max (cadr p2) (cadr p3)) tscale))
(> (cadr p1) (+ (min (cadr p2) (cadr p3)) tscale))
)
0
)
((or(> (car p1) (+ (max (car p2) (car p3)) tscale))
(< (car p1) (- (min (car p2) (car p3)) tscale))
(> (cadr p1) (+ (max (cadr p2) (cadr p3)) tscale))
(< (cadr p1) (- (min (cadr p2) (cadr p3)) tscale))
)
1
)
(t nil)
)
)
;;=================================子函数开始=================================
;;名称: h_mxwz
;;功能: 母线位置判断
;;输入: emx p1 p2
;;返回: mxwzt
(defun h_mxwz (emx p1 p2 / pd1 pd2 pc mxwzt)
(setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0)))
(if (or (> (car pc) (max (car p1) (car p2)))
(> (cadr pc) (max (cadr p1) (cadr p2)))
(< (car pc) (min (car p1) (car p2)))
(< (cadr pc) (min (cadr p1) (cadr p2)))
)
(setq mxwzt nil)
(setq mxwzt pc)
)
mxwzt
)
;;=================================子函数开始=================================
;;名称: h_wzpd
;;功能: 位置判断、判断实体（块-插入点，线-二端点）是否在窗口之内
;;输入: 实体名窗口二角点
;;返回: 在窗口内-中点
;; 不在窗口内-T
;; 交叉(线)-nil
(defun h_wzpd (emx p1 p2 ss / pd1 pd2 pc wzt npd1 npd2 es sins i)
(cond
((= (cdr (assoc 0 (entget emx))) "LWPOLYLINE")
(setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0)))
(setq npd1 (h_inwi pd1 p1 p2)
npd2 (h_inwi pd2 p1 p2)
)
(cond
((or(and (= npd1 0) (= npd2 1))(and (= npd2 0) (= npd1 1)))
(setq wzt nil)
)
((or (= npd1 1) (= npd2 1))
(setq wzt t)
)
(t (setq wzt pc))
)
)
(t
(setq pc (cdr (assoc 10 (entget emx))))
(cond
((= (h_inwi pc p1 p2) 1)
(setq wzt t)
)
((null (h_inwi pc p1 p2))
(if (= (cdr (assoc 0 (entget emx))) "insert")
(progn
(setq sins (ssget "c"
(polar pc (* 0.25 pi) tscale)
(polar pc (* 0.25 pi) tscale)
'((0 . "insert,lwpolyline"))
)
)
(setq wzt pc
i 0
)
(while (and wzt (< i (sslength sins)))
(setq es (ssname sins i))
(if (not (ssmemb es sins))
(setq wzt t)
(setq i (1+ i))
)
)
)
(setq wzt pc)
)
)
(t (setq wzt pc))
)
)
)
wzt
)
;;=================================子函数开始=================================
;;名称: h_wzyz
;;功能: 母线位置一致性判断
;;输入: 母线循环号 (方向初值坐标初值)
;;返回: i=0 (方向坐标)
;; i/=0 位置一致 t
;; 位置不一致 nil
(defun h_wzyz (emx i first / fxhsf hszf pmxd1 pmxd2 fxhs hsz wzyz)
(setq fxhsf (car first)
hszf (cadr first)
)
(setq pmxd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pmxd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(if(equal (car pmxd1) (car pmxd2) 0.001)
(setq fxhs 1 hsz (car pmxd1))
(setq fxhs 0 hsz (cadr pmxd1))
)
(if(= i 0)
(setq wzyz (list fxhs hsz))
(progn
(if (or(not (equal fxhs fxhsf 0.01))
(not (equal hsz hszf 0.01))
)
(setq wzyz nil)
(setq wzyz t)
)
)
)
wzyz
)
;;=================================子函数开始=================================
;;名称: h_xzhl
;;功能: 选择回路
;;输入: 窗口二角点p1，p2
;;返回: t-(基点方向? 宽度回路选择集回路数) 方向--0 向下 1 向右 2 向上 3 向左
;; NIL-nil
(defun h_xzhl (p1 p2 / ssfah fah pjd fx sshl hlsm
kd hll smx i mxt fxhs hsz len1 ii
emx iii pd1 pd2 mxmin mxmax p1 p2 pc
ss i4 pcl first e pcxl pcyl pcc xzt
len2
)
(setq hll nil)
(setq smx (ssget "c" p1 p2 '((0 . "lwpolyline") (8 . "mx"))))
(if smx
(progn
(setq i 0 mxt t)
(while (and mxt (< i (sslength smx)))
(setq emx (ssname smx i))
(if (= i 0)
(setq first (h_wzyz emx 0 nil))
(setq mxt (h_wzyz emx i first))
)
(setq i (1+ i))
) ;判断母线位置一致性
(if mxt
(progn
(setq fxhs (car first)
hsz (cadr first)
ii 0
len1 (sslength smx)
)
(repeat len1
(setq emx (ssname smx ii))
(if (h_mxwz emx p1 p2)
(setq ii (1+ ii))
(ssdel emx smx)
)
) ;删除中心在边界外的母线
(setq hlsm (sslength smx))
(if (/= hlsm 0)
(progn
(setq iii 0)
(repeat hlsm
(setq emx (ssname smx iii))
(setq pd1 (cdr (assoc 10 (entget emx)))
pd2 (cdr (assoc 10 (reverse (entget emx))))
)
(if (= fxhs 0)
(if (= iii 0)
(setq mxmin (min (car pd1) (car pd2))
mxmax (max (car pd1) (car pd2))
)
(progn
(if (< (min (car pd1) (car pd2)) mxmin)
(setq mxmin (min (car pd1) (car pd2)))
)
(if (> (max (car pd1) (car pd2)) mxmax)
(setq mxmax (max (car pd1) (car pd2)))
)
)
)
(if (= iii 0)
(setq mxmin (min (cadr pd1) (cadr pd2))
mxmax (max (cadr pd1) (cadr pd2))
)
(progn
(if (< (min (cadr pd1) (cadr pd2)) mxmin)
(setq mxmin (min (cadr pd1) (cadr pd2)))
)
(if (> (max (cadr pd1) (cadr pd2)) mxmax)
(setq mxmax (max (cadr pd1) (cadr pd2)))
)
)
)
)
(setq iii (1+ iii))
)
(setq kd (- mxmax mxmin))
(if (= fxhs 0)
(setq p1 (list mxmin (cadr p1) 0.0)
p2 (list mxmax (cadr p2) 0.0)
pjd (list (/ (+ mxmin mxmax) 2) hsz 0.0)
)
(setq p1 (list (car p1) mxmin 0.0)
p2 (list (car p2) mxmax 0.0)
pjd (list hsz (/ (+ mxmin mxmax) 2) 0.0)
)
) ;取得母线范围并更新选择集窗口
(setq ss (ssget "c" p1 p2 '((8 . "mx,fah,bxt,xhgg,xmdh"))))
(setq i4 0
pcl nil
len2 (sslength ss)
xzt t
)
(while (and xzt (< i4 len2))
(setq e (ssname ss i4))
(if (setq pc (h_wzpd e p1 p2 smx))
(progn
(if (= pc t)
(progn
(ssdel e ss)
(setq len2 (1- len2))
)
(progn
(setq pcl (cons pc pcl))
(setq i4 (1+ i4))
)
)
)
(setq xzt nil)
)
)
;去掉多余实体,如果交叉结束
(if xzt
(progn
(setq pcxl (mapcar 'car pcl)
pcyl (mapcar 'cadr pcl)
)
(setq pcc (list (/ (apply '+ pcxl) (length pcl))
(/ (apply '+ pcyl) (length pcl))
0.0
)
)
(if (= fxhs 0)
(if (< (cadr pcc) (cadr pjd))
(setq fx 0)
(setq fx 2)
)
(if (> (car pcc) (car pjd))
(setq fx 1)
(setq fx 3)
)
)
(setq hll (list pjd fx kd ss hlsm))
)
(Xacino "回路选择不完整!" "操作错误" 6)
)
)
)
)
(Xacino "选了其他回路的母线!" "操作错误" 6)
)
)
)
hll
)
;;=================================子函数开始=================================
;;名称: h_lxdd
;;功能: 连续母线端点
;;输入: 端点方向
;;返回: 下一端点
(defun h_lxdd (pds fx hljj / p1 p2 lxl pde e hs smxal)
(setq pde nil)
(setq smxal (ssget "x" '((8 . "mx"))))
(if(or (= fx 0) (= fx 2))
(setq lxl (list (car pds)))
(setq lxl (list (cadr pds)))
)
(while (setq e (ssname smxal 0))
(setq p1 (cdr (assoc 10 (entget e)))
p2 (cdr (assoc 10 (reverse (entget e))))
)
(if (or (= fx 0) (= fx 2))
(if (and (equal (cadr p1) (cadr pds) 0.001)
(equal (cadr p2) (cadr pds) 0.001)
)
(if (> (setq hs (max (car p1) (car p2))) (car pds))
(setq lxl (cons hs lxl))
)
)
(if (and (equal (car p1) (car pds) 0.001)
(equal (car p2) (car pds) 0.001)
)
(if (> (setq hs (max (cadr p1) (cadr p2))) (cadr pds))
(setq lxl (cons hs lxl))
)
)
)
(ssdel e smxal)
)
(if(> (length lxl) 1)
(setq lxl (qsort h_comp lxl))
)
(while (and (> (length lxl) 1)
(< (- (cadr lxl) (car lxl)) (* 1.5 hljj))
)
(setq lxl (cdr lxl))
(if (or (= fx 0) (= fx 2))
(setq pde (list(car lxl)(cadr pds) 0.0))
(setq pde (list(car pds)(car lxl) 0.0))
)
)
pde
)
;;=================================子函数开始=================================
;;名称: h_lxxz
;;功能: 连续回路选择,选择由一点开始的所有连续同方向回路
;;输入: 开始点结束点方向
;;返回: 选择集
(defun h_lxxz (pds pde fx / p1 p2 ss i ls emx dqw1 wzpdt)
(setq ss nil)
(if (and pds pde)
(progn
(cond
((= fx 0)
(setq p1 (polar pds (* 1.5 pi) (* 90 tscale))
p2 (polar pde (* 0.5 pi) (* 2 tscale))
)
)
((= fx 1)
(setq p1 (polar pds pi (* 2 tscale))
p2 (polar pde 0 (* 90 tscale))
)
)
((= fx 2)
(setq p1 (polar pds (* 1.5 pi) (* 2 tscale))
p2 (polar pde (* 0.5 pi) (* 90 tscale))
)
)
((= fx 3)
(setq p1 (polar pds pi (* 90 tscale))
p2 (polar pde 0 (* 2 tscale))
)
)
)
(setq dqw1 (XScjx))
(if (or (= (h_inwi p1 (car dqw1) (cadr dqw1)) 1)
(= (h_inwi p2 (car dqw1) (cadr dqw1)) 1)
)
(progn
(command "_.zoom"
(list (min (car p1) (caar dqw1))
(min (cadr p1) (cadar dqw1))
)
(list (max (car p2) (caadr dqw1))
(max (cadr p2) (cadadr dqw1))
)
)
)
)
(setq ss (ssget "c" p1 p2 '((8 . "mx,bxt,fah,xhgg,xmdh"))))
(setq i 0
ls (sslength ss)
)
(repeat ls
(setq emx (ssname ss i))
(setq wzpdt (h_wzpd emx p1 p2 ss))
(if (or (null wzpdt) (= wzpdt t))
(ssdel emx ss)
(setq i (1+ i))
)
)
)
)
ss
)
;;=================================子函数开始=================================
;;名称: h_hlhz
;;功能: 回路绘制
;;输入: 回路起始点方向回路间距
;;返回: 无
(defun h_hlhz(pjd fx dist data1 data2 sm2 / zdist pds pdmx2 pdmx1 mxkd shu)
(setq zdist (* sm2 dist))
(Xsetin "Hlklib" "Hlkjj" (rtos (/ dist tscale) 2 2) 1)
(shldy pjd fx data1 data2) ;回路绘制
(command "_.color" "_green")
(command "_.Layer" "_m" "mx" "_c" 3 "" "")
(if (or (= fx 0) (= fx 2))
(setq pds (polar pjd 0 (* -0.5 zdist)))
(setq pds (polar pjd (* 0.5 pi) (* -0.5 zdist)))
)
(setq pdmx1 pds)
(repeat sm2
(if (or (= fx 0) (= fx 2))
(setq pdmx2 (polar pdmx1 0 dist))
(setq pdmx2 (polar pdmx1 (* 0.5 pi) dist))
)
(setq mxkd (atof (Xgetin "Hlklib" "Hlkmx" "0.6" 1)))
(setq mxkd (* mxkd tscale))
(command "_.pline" pdmx1 "_w" mxkd "" pdmx2 "")
(setq pdmx1 pdmx2)
) ;母线绘制
(setq shu(tblsearch "layer""GDXT"))
(if shu(command "_.layer" "_set" "GDXT" ""))
)
;;=================================子函数开始=================================
;;名称: h_sh1
;;功能: 回路替换
;;输入: 无
;;返回: 无
(defun h_sh1(/ lll1 ph1 ph2 ttt1 hlxzl pjd fx kd sshl hlsm lll2 ttt2 ph3 ph4
lxfs slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj
jjn sshl hldata data1 data2 dist sm2 smov zxj ysj zxjn ysjn mylist
plist xlist ylist ess fan i shu)
(setq zxj (car(XScjx)))
(setq ysj (last(XScjx)))
(setq lll1 t)
(while lll1
(command "_.undo" "_group")
(setq shu(tblsearch "layer""GDXT"))
(if shu(command "_.layer" "_set" "GDXT" ""))
(setq fan 1)
(prompt "\n请用窗口(W)选择被替回路:")
(setq ph1 1)
(while (not(listp ph1))
(initget 128)
(setq ph1 (getpoint "\n请输入窗口第一点<回车结束>:"))
)
(if ph1
(progn
(setq ttt1 t)
(while ttt1
(setq ph2 1)
(while (not(listp ph2))
(initget 128)
(setq ph2 (getcorner ph1 "\n请输入窗口第二点:"))
)
(if ph2
(progn
(setq hlxzl (h_xzhl ph1 ph2))
(if hlxzl
(progn
(setq ttt1 nil)
(setq pjd (nth 0 hlxzl)
fx (nth 1 hlxzl)
kd (nth 2 hlxzl)
sshl (nth 3 hlxzl)
hlsm (nth 4 hlxzl)
)
(setq i 0)
(repeat (sslength sshl)
(redraw (ssname sshl i) 3)
(setq i (1+ i))
)
(setq lxfs 1 slx sshl)
(if(=(IfWndVis "hlklibclass") 0)
(hlklib 0 1 "s" 0 1 1 0 0)
(progn
(xsetin "Hlklib" "Hlkpara" "0&1&0&1&1&0&0" 1)
(xsetin "Hlklib" "RetHlkMes" "s" 1)
)
)
(setq lll2 t)
(while lll2
(prompt "\n请用窗口(W)或从图库选择替换回路:")
(setq ph3 1)
(while (and(/= ph3 "s")(not(listp ph3)))
(initget 128 "s")
(setq ph3(getpoint"\n请输入窗口第一点或请选取方案<回车结束>:"))
)
(cond
((and(listp ph3)ph3)
(setq ttt2 t)
(while ttt2
(setq ph4 1)
(while(not(listp ph4))
(initget 128)
(setq ph4(getcorner ph3 "\n请输入窗口第二点:"))
)
(if ph4
(progn
(setq hlxzln (h_xzhl ph3 ph4))
(if hlxzln
(progn
(setq pjdf (nth 0 hlxzln)
fxn (nth 1 hlxzln)
kdn (nth 2 hlxzln)
sshln (nth 3 hlxzln)
hlsmn (nth 4 hlxzln)
)
(setq jj(/ kd hlsm) jjn (/ kdn hlsmn))
(if (and (equal jj jjn 0.01)(= fx fxn))
(progn
(setq ttt2 nil lll2 nil)
(if (or (= fx 0) (= fx 2))
(setq pjdn (polar pjd 0 (/ (- kdn kd) 2.0))
pmds (polar pjd 0 (/ kd 2.0))
pmdsn (polar pmds 0(- kdn kd))
)
(setq pjdn (polar pjd (* 0.5 pi) (/ (- kdn kd) 2.0))
pmds (polar pjd (* 0.5 pi) (/ kd 2.0))
pmdsn (polar pmds(* 0.5 pi) (- kdn kd))
)
)
(setq pmde (h_lxdd pmds fx jj))
(setq smov (h_lxxz pmds pmde fx))
(setq mylist(Dhtss pjd 2))
(if(and mylist (or(= fx 0)(= fx 2)))
(progn
(setq zxjn (car(XScjx)))
(setq ysjn (last(XScjx)))
(C_zoom mylist zxjn ysjn)
(setq ylist(C_xyzb mylist pjd kd))
(setq plist(C_ldel mylist pjd kd sshl))
(setq xlist(C_movt plist kd kdn sshln pjdf pjdn smov 0))
(setq ess(last plist))
(command "_.erase" ess "")
(command "_.erase" sshl "")
(command "_.layer" "_set" "GDXT" "")
(C_slin (car xlist) ylist)
(C_slin (last xlist) ylist)
(C_hlin xlist ylist hlsmn)
(command "_.zoom" zxj ysj)
)
(progn
(command "_.copy" sshln "" pjdf pjdn)
(if smov(command "_.move" smov "" pmds pmdsn))
(command "_.erase" sshl "")
)
)
)
(progn
(Xacino "所选回路的出线方向或间距不对,请重新选择!" "注意" 6)
(setq ttt2 nil)
)
)
)
(setq ttt2 nil)
)
)
)
)
)
((= ph3 "s")
(setq lll2 nil)
(setq hldata (xgetin "Hlklib" "Hlkdata" "" 1))
(setq data1(_getnS hldata 1 "&") data2(_getnS hldata 2 "&"))
(setq dist (/ kd hlsm))
(setq sm2 (fhlnum data1 data2))
(setq kdn (* sm2 dist))
(if(or(= fx 0)(= fx 2))
(setq pjdn (polar pjd 0 (/ (- kdn kd) 2.0))
pmds (polar pjd 0 (/ kd 2.0))
pmdsn(polar pmds 0 (- kdn kd))
)
(setq pjdn (polar pjd(* 0.5 pi)(/ (- kdn kd) 2.0))
pmds (polar pjd (* 0.5 pi) (/ kd 2.0))
pmdsn(polar pmds (* 0.5 pi) (- kdn kd))
)
)
(setq pmde (h_lxdd pmds fx dist))
(setq smov (h_lxxz pmds pmde fx))
(setq mylist(dhtss pjd 2))
(if (and mylist (or (= fx 0) (= fx 2)))
(progn
(setq zxjn (car(XScjx)))(setq ysjn (last(XScjx)))
(C_zoom mylist zxjn ysjn)
(setq ylist (C_xyzb mylist pjd kd))
(setq plist (C_ldel mylist pjd kd sshl))
(setq xlist (C_movk plist kd kdn pjdn fx dist data1 data2 sm2 smov 1))
(setq ess (last plist))
(command "_.erase" ess "")
(command "_.erase" sshl "")
(command "_.layer" "_set" "GDXT" "")
(C_slin (car xlist) ylist)
(C_slin (last xlist) ylist)
(C_hlin xlist ylist sm2)
(command "_.zoom" zxj ysj)
)
(progn
(if smov(command "_.move" smov "" pmds pmdsn))
(command "_.erase" sshl "")
(h_hlhz pjdn fx dist data1 data2 sm2)
)
)
)
(t(setq lll2 nil)) ;回车结束
)
) ;替换选取循环
)
(setq ttt1 nil)
)
)
)
)
)
(setq lll1 nil)
) ;是否ph1--t
(if(= lxfs 1)
(progn
(setq i 0)
(repeat (sslength slx)
(redraw (ssname slx i) 4)
(setq i (1+ i))
)
(setq lxfs 0)
)
)
(command "_.undo" "_end")
(setq fan 0)
) ;被替换选取循环
)
;;================================子函数结束==================================
(_inidwg)
(princ "\n*回路替换*=Hlth")
(setvar "plinetype" 2)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "pickadd" 1)
(setvar "osmode" 0)
(setvar "CECOLOR" "green")
(setq ucmark (getvar "worlducs"))
(if (= ucmark 0)
(progn
(setq ucs_fo (getvar "ucsfollow"))
(if (= ucs_fo 1)(setvar "ucsfollow" 0))
(command "_.ucs" "_world")
)
)
(setq lxfs 0 tscale(atof(xrddic "Tabscale" "100")) dqw(XScjx))
(setq o_para(xgetin "Hlklib" "Hlkpara" "" 1)
o_mes(xgetin "Hlklib" "RetHlkMes" "" 1)
o_jj(xgetin "Hlklib" "Hlkjj" "30" 1)
)
(menucmd "s=hd25l")
(h_sh1)
(if(= ucmark 0)(command "_.ucs" "_prev"))
(setvar "highlight" 1)
(setq dqwn(XScjx))
(if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw)))
(setq *error* olderr olderr nil)
(_resdwg)
(princ)
)
;;=================================主程序开始=================================
;;名称：C:HLHH
;;功能：简版回路编辑-回路互换
;;输入：无
;;返回：无
(defun C:HLHH(/ tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo
h_sh2 h_XZHL h_WZYZ h_HLHZ h_LXDD h_WZPD h_LXXZ h_mxwz h_inwi
h_comp C_zoom C_ssgl C_xyzb C_ldel C_movt C_movk C_hlin C_slin
s_px)
(setq olderr *error*)
;;=================================子函数开始=================================
;;名称：*error*(错误处理函数)
;;功能：当程序发生错误或用户中断时，平静地退出，并还原状态。
;;输入：无
;;返回：无
(defun *error* (msg / each)
(if (= fan 1)(command "_.undo" "_end"))
(if (= fan 1)(command "_.undo" ""))
(if (= ucmark 0) (command "_.ucs" "_prev"))
(xsetin "Hlklib" "Hlkpara" o_para 1)
(xsetin "Hlklib" "RetHlkMes" o_mes 1)
(xsetin "Hlklib" "Hlkjj" o_jj 1)
(if(= lxfs 1)
(progn(setq i 0)(repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i))))
)
(setq dqwn (XScjx))
(if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw)))
(foreach each
'(tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo h_sh2 h_xzhl
h_wzyz h_hlhz h_lxdd h_wzpd h_lxxz h_mxwz h_inwi h_comp C_zoom C_ssgl C_xyzb
C_ldel C_movt C_movk C_hlin C_slin point1 point2 i ename point3 point4 ss
elist point5 point6 biao ylist plist l xlist n nylist s_px yy list1 list2 a b
emx p1 p2 p3 pd1 pd2 pc mxwzt wzt npd1 npd2 es sins first fxhsf hszf pmxd1
pmxd2 fxhs hsz wzyz ssfah fah pjd fx sshl hlsm kd hll smx mxt len1 ii iii mxmin
mxmax i4 pcl e pcxl pcyl pcc xzt len2 pds hljj lxl pde hs smxal ls dqw1 wzpdt
dist data1 data2 sm2 zdist pdmx2 mxkd lll1 ph1 ph2 ttt1 hlxzl lll2 ttt2 ph3 ph4
slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj jjn hldata smov zxj
ysj zxjn ysjn mylist ess fan name laye yanse hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 pjd2
fx2 kd2 hlsm2 hlxzl2 pjdn1 pjd1n pjd2n pme smov1 smov2 pmds1 pmds1n pmds2 pmds2n
pmde1 pmde2 jj1 jj2 sshl2 s2_ss3 s2_lsx ss1 ss2 ss3 ylist1 ylist2 plist1 plist2
xlist1 xlist2 ess1 ess2 point shu xzb)
(set each nil)
)
(setq each nil)
(setq *error* olderr olderr nil)
(_resdwg)
(princ)
)
;;=================================子函数开始=================================
;;名称：C_zoom
;;功能：判断是否zoom
;;输入：mylist-订货图的角表 zxj-视区左下角 ysj-视区右上角
;;返回：无
(defun C_zoom(mylist zxjn ysjn / point1 point2)
(setq point1(car mylist))
(setq point2(last mylist))
(if(or(>(car zxjn)(car point2))(<(car ysjn)(car point1))
(>(cadr zxjn)(cadr point1))(<(cadr ysjn)(cadr point2))
)
(command "_.ZOOM" "_w" point1 point2)
)
)
;;=================================子函数开始=================================
;;名称：C_ssgl
;;功能：过滤选择集
;;输入：ss1-选择集1 ss2-选择集2
;;返回：ss1
(defun C_ssgl(ss1 ss2 / i ename)
(setq i 0)
(repeat(sslength ss2)
(setq ename (ssname ss2 i))
(ssdel ename ss1)
(setq i (+ i 1))
)
ss1
)
;;=================================子函数开始=================================
;;名称：C_xyzb
;;功能：得到所选回路所有横线的Y坐标点集
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长
;;返回：ylist-所选回路所有横线的Y坐标表
(defun C_xyzb(mylist pjd kd / point1 point2 point3 point4 i ss ename elist
point5 point6 biao ylist)
(setq ylist '())
(setq point1(car mylist))
(setq point2(last mylist))
(setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2)))
(setq point4(list(+(car point3)kd)(cadr point1)(last point1)))
(setq ss (ssget "W" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3))))
(setq i 0)
(repeat (sslength ss)
(setq ename (ssname ss i))
(setq elist (entget ename))
(setq point5(cdr(assoc 10 elist)))
(setq point6(cdr(assoc 11 elist)))
(if (equal(cadr point5)(cadr point6)0.1)
(progn
(setq biao(member (cadr point5) ylist))
(if (not biao)
(setq ylist(cons (cadr point5) ylist))
)
)
)
(setq i (+ i 1))
)
ylist
)
;;=================================子函数开始=================================
;;名称：C_ldel
;;功能：得到所选回路列的左上角和右下角
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 sshl-回路选择集
;;返回：plist-点表(所选回路列的右上角、订货图的右下角和所选回路列的选择集)
(defun C_ldel(mylist pjd kd sshl / point1 point2 point3 point4 point5 ss plist)
(setq point1(car mylist))
(setq point2(last mylist))
(setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2)))
(setq point4(list(+(car pjd)(/ kd 2))(cadr point1)(last point2)))
(setq ss(ssget "w" point3 point4))
(setq ss(C_ssgl ss sshl))
(setq point5(list(car point4)(cadr point2)(last point2)))
(setq plist (list point5 point1 ss))
)
;;=================================子函数开始=================================
;;名称：C_movt
;;功能：copy回路并移动表格(从当前图中copy或move)
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度
;; sshln-替换回路 pjdf-替换回路的基点 pjd-被替回路的基点 smov-回路选择集
;; a-为0时拷贝,为1时移动,为2时插入
;;返回：xlist-新回路列的x坐标
(defun C_movt(plist kd kdn sshln pjdf pjdn smov a / point1 point2 l point3 point4 xlist ss)
(setq point1(car plist))
(setq point2(cadr plist))
(if(or(= a 0)(= a 1))
(progn
(setq l(- kd kdn))
(setq point3(list(-(car point1)l)(cadr point1)(last point1)))
(setq ss(ssget "w" point1 point2))
(if (= a 0)
(command "_.copy" sshln "" pjdf pjdn)
(command "_.move" sshln "" pjdf pjdn)
)
(if smov
(progn
(command "_.move" smov "" point1 point3)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point1 point3)
(setq xlist(list(-(car point1)kd)(car point3)))
)
(progn
(setq point3(list(-(car point1)kd)(cadr point1)(last point1)))
(setq point4(list(+(car point3)kdn)(cadr point3)(last point3)))
(setq ss (ssget "w" point3 point2))
(command "_.copy" sshln "" pjdf pjdn)
(if smov
(progn
(command "_.move" smov "" point3 point4)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point3 point4)
(setq xlist(list(car point3)(car point4)))
)
)
xlist
)
;;=================================子函数开始=================================
;;名称：C_movk
;;功能：copy回路并移动表格(从图库中取)
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度
;; pjdn-替换回路 fx-回路方向 dist、data1、data2、sm2-调回路库的参数 smov-回路选择集
;; a-为时替换回路,为2时插入回路
;;返回：xlist-新回路列的两个x坐标
(defun C_movk(plist kd kdn pjdn fx dist data1 data2 sm2 smov a / point1 point2 l point3
point4 xlist ss)
(setq point1(car plist))
(setq point2(cadr plist))
(if (= a 1)
(progn
(setq l(- kd kdn))
(setq point3(list(-(car point1)l)(cadr point1)(last point1)))
(setq ss(ssget "w" point1 point2))
(h_hlhz pjdn fx dist data1 data2 sm2)
(if smov
(progn
(command "_.move" smov "" point1 point3)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point1 point3)
(setq xlist(list(-(car point1)kd)(car point3)))
)
(progn
(setq point3(list(-(car point1)kd)(cadr point1)(last point1)))
(setq point4(list(+(car point3)kdn)(cadr point3)(last point3)))
(setq ss (ssget "w" point3 point2))
(h_hlhz pjdn fx dist data1 data2 sm2)
(if smov
(progn
(command "_.move" smov "" point3 point4)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point3 point4)
(setq xlist(list(car point3)(car point4)))
)
)
xlist
)
;;=================================子函数开始=================================
;;名称：C_hlin
;;功能：画横线
;;输入：xlist-新订货图的x坐标表 ylist-所选订货图所有横线的Y坐标表 hlsm-回路数目
;;返回：无
(defun C_hlin(xlist ylist hlsm / point1 point2 i l n)
(setq i 0)
(setq l(/(abs(-(car xlist)(last xlist)))hlsm))
(repeat (length ylist)
(setq n 0)
(repeat hlsm
(setq point1(list(+(car xlist)(* l n))(nth i ylist)0.0))
(setq point2(list(+(car xlist)(* l (+ n 1)))(nth i ylist)0.0))
(command "_.line" point1 point2 "")
(setq n (+ n 1))
)
(setq i (+ i 1))
)
)
;;=================================子函数开始=================================
;;名称：s_px
;;功能：排序(从大到小)
;;输入：ylist-所选订货图所有横线的Y坐标表
;;返回：nylist
(defun s_px(ylist / i nylist yy list1 list2)
(setq nylist '())
(while (/= (length ylist) 0)
(setq i 1)
(setq yy (nth 0 ylist))
(repeat (-(length ylist)1)
(if (> yy (nth i ylist))
(setq yy (nth i ylist))
)
(setq i (+ i 1))
)
(setq nylist (cons yy nylist))
(setq list1 (cdr (member yy ylist)))
(setq list2 (cdr (member yy (reverse ylist))))
(setq ylist (append list1 list2))
)
nylist
)
;;=================================子函数开始=================================
;;名称：C_slin
;;功能：画竖线
;;输入：xzb-x坐标 ylist-所选订货图所有横线的Y坐标表
;;返回：无
(defun C_slin(xzb ylist / nylist point1 point2 i)
(setq i 0)
(setq nylist(s_px ylist))
(repeat (-(length nylist)1)
(setq point1(list xzb (nth i nylist)))
(setq point2(list xzb (nth (+ i 1) nylist)))
(command "_.line" point1 point2 "")
(setq i (+ i 1))
)
)
;;=================================子函数开始=================================
;;名称：h_comp
;;功能：计算两值的差(用于排序)
;;输入：a、b
;;返回：两值的差
(defun h_comp (a b)
(- a b)
)
;;=================================子函数开始=================================
;;名称: h_inwi
;;功能: 判断p1是否在p2 p3组成的窗口内
;;输入: p1 p2 p3
;;返回: 0-在窗口内、1-在窗口外、nil-边界上
(defun h_inwi (p1 p2 p3)
(cond
((and(< (car p1) (- (max (car p2) (car p3)) tscale))
(> (car p1) (+ (min (car p2) (car p3)) tscale))
(< (cadr p1) (- (max (cadr p2) (cadr p3)) tscale))
(> (cadr p1) (+ (min (cadr p2) (cadr p3)) tscale))
)
0
)
((or(> (car p1) (+ (max (car p2) (car p3)) tscale))
(< (car p1) (- (min (car p2) (car p3)) tscale))
(> (cadr p1) (+ (max (cadr p2) (cadr p3)) tscale))
(< (cadr p1) (- (min (cadr p2) (cadr p3)) tscale))
)
1
)
(t nil)
)
)
;;=================================子函数开始=================================
;;名称: h_mxwz
;;功能: 母线位置判断
;;输入: emx p1 p2
;;返回: mxwzt
(defun h_mxwz (emx p1 p2 / pd1 pd2 pc mxwzt)
(setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0)))
(if (or (> (car pc) (max (car p1) (car p2)))
(> (cadr pc) (max (cadr p1) (cadr p2)))
(< (car pc) (min (car p1) (car p2)))
(< (cadr pc) (min (cadr p1) (cadr p2)))
)
(setq mxwzt nil)
(setq mxwzt pc)
)
mxwzt
)
;;=================================子函数开始=================================
;;名称: h_wzpd
;;功能: 位置判断、判断实体（块-插入点，线-二端点）是否在窗口之内
;;输入: 实体名窗口二角点
;;返回: 在窗口内-中点
;; 不在窗口内-T
;; 交叉(线)-nil
(defun h_wzpd (emx p1 p2 ss / pd1 pd2 pc wzt npd1 npd2 es sins i)
(cond
((= (cdr (assoc 0 (entget emx))) "LWPOLYLINE")
(setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0)))
(setq npd1 (h_inwi pd1 p1 p2)
npd2 (h_inwi pd2 p1 p2)
)
(cond
((or(and (= npd1 0) (= npd2 1))(and (= npd2 0) (= npd1 1)))
(setq wzt nil)
)
((or (= npd1 1) (= npd2 1))
(setq wzt t)
)
(t (setq wzt pc))
)
)
(t
(setq pc (cdr (assoc 10 (entget emx))))
(cond
((= (h_inwi pc p1 p2) 1)
(setq wzt t)
)
((null (h_inwi pc p1 p2))
(if (= (cdr (assoc 0 (entget emx))) "insert")
(progn
(setq sins (ssget "c"
(polar pc (* 0.25 pi) tscale)
(polar pc (* 0.25 pi) tscale)
'((0 . "insert,lwpolyline"))
)
)
(setq wzt pc
i 0
)
(while (and wzt (< i (sslength sins)))
(setq es (ssname sins i))
(if (not (ssmemb es sins))
(setq wzt t)
(setq i (1+ i))
)
)
)
(setq wzt pc)
)
)
(t (setq wzt pc))
)
)
)
wzt
)
;;=================================子函数开始=================================
;;名称: h_wzyz
;;功能: 母线位置一致性判断
;;输入: 母线循环号 (方向初值坐标初值)
;;返回: i=0 (方向坐标)
;; i/=0 位置一致 t
;; 位置不一致 nil
(defun h_wzyz (emx i first / fxhsf hszf pmxd1 pmxd2 fxhs hsz wzyz)
(setq fxhsf (car first)
hszf (cadr first)
)
(setq pmxd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pmxd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(if(equal (car pmxd1) (car pmxd2) 0.001)
(setq fxhs 1 hsz (car pmxd1))
(setq fxhs 0 hsz (cadr pmxd1))
)
(if(= i 0)
(setq wzyz (list fxhs hsz))
(progn
(if (or(not (equal fxhs fxhsf 0.01))
(not (equal hsz hszf 0.01))
)
(setq wzyz nil)
(setq wzyz t)
)
)
)
wzyz
)
;;=================================子函数开始=================================
;;名称: h_xzhl
;;功能: 选择回路
;;输入: 窗口二角点p1，p2
;;返回: t-(基点方向? 宽度回路选择集回路数) 方向--0 向下 1 向右 2 向上 3 向左
;; NIL-nil
(defun h_xzhl (p1 p2 / ssfah fah pjd fx sshl hlsm
kd hll smx i mxt fxhs hsz len1 ii
emx iii pd1 pd2 mxmin mxmax p1 p2 pc
ss i4 pcl first e pcxl pcyl pcc xzt
len2
)
(setq hll nil)
(setq smx (ssget "c" p1 p2 '((0 . "lwpolyline") (8 . "mx"))))
(if smx
(progn
(setq i 0 mxt t)
(while (and mxt (< i (sslength smx)))
(setq emx (ssname smx i))
(if (= i 0)
(setq first (h_wzyz emx 0 nil))
(setq mxt (h_wzyz emx i first))
)
(setq i (1+ i))
) ;判断母线位置一致性
(if mxt
(progn
(setq fxhs (car first)
hsz (cadr first)
ii 0
len1 (sslength smx)
)
(repeat len1
(setq emx (ssname smx ii))
(if (h_mxwz emx p1 p2)
(setq ii (1+ ii))
(ssdel emx smx)
)
) ;删除中心在边界外的母线
(setq hlsm (sslength smx))
(if (/= hlsm 0)
(progn
(setq iii 0)
(repeat hlsm
(setq emx (ssname smx iii))
(setq pd1 (cdr (assoc 10 (entget emx)))
pd2 (cdr (assoc 10 (reverse (entget emx))))
)
(if (= fxhs 0)
(if (= iii 0)
(setq mxmin (min (car pd1) (car pd2))
mxmax (max (car pd1) (car pd2))
)
(progn
(if (< (min (car pd1) (car pd2)) mxmin)
(setq mxmin (min (car pd1) (car pd2)))
)
(if (> (max (car pd1) (car pd2)) mxmax)
(setq mxmax (max (car pd1) (car pd2)))
)
)
)
(if (= iii 0)
(setq mxmin (min (cadr pd1) (cadr pd2))
mxmax (max (cadr pd1) (cadr pd2))
)
(progn
(if (< (min (cadr pd1) (cadr pd2)) mxmin)
(setq mxmin (min (cadr pd1) (cadr pd2)))
)
(if (> (max (cadr pd1) (cadr pd2)) mxmax)
(setq mxmax (max (cadr pd1) (cadr pd2)))
)
)
)
)
(setq iii (1+ iii))
)
(setq kd (- mxmax mxmin))
(if (= fxhs 0)
(setq p1 (list mxmin (cadr p1) 0.0)
p2 (list mxmax (cadr p2) 0.0)
pjd (list (/ (+ mxmin mxmax) 2) hsz 0.0)
)
(setq p1 (list (car p1) mxmin 0.0)
p2 (list (car p2) mxmax 0.0)
pjd (list hsz (/ (+ mxmin mxmax) 2) 0.0)
)
) ;取得母线范围并更新选择集窗口
(setq ss (ssget "c" p1 p2 '((8 . "mx,fah,bxt,xhgg,xmdh"))))
(setq i4 0
pcl nil
len2 (sslength ss)
xzt t
)
(while (and xzt (< i4 len2))
(setq e (ssname ss i4))
(if (setq pc (h_wzpd e p1 p2 smx))
(progn
(if (= pc t)
(progn
(ssdel e ss)
(setq len2 (1- len2))
)
(progn
(setq pcl (cons pc pcl))
(setq i4 (1+ i4))
)
)
)
(setq xzt nil)
)
)
;去掉多余实体,如果交叉结束
(if xzt
(progn
(setq pcxl (mapcar 'car pcl)
pcyl (mapcar 'cadr pcl)
)
(setq pcc (list (/ (apply '+ pcxl) (length pcl))
(/ (apply '+ pcyl) (length pcl))
0.0
)
)
(if (= fxhs 0)
(if (< (cadr pcc) (cadr pjd))
(setq fx 0)
(setq fx 2)
)
(if (> (car pcc) (car pjd))
(setq fx 1)
(setq fx 3)
)
)
(setq hll (list pjd fx kd ss hlsm))
)
(Xacino "回路选择不完整!" "操作错误" 6)
)
)
)
)
(Xacino "选了其他回路的母线!" "操作错误" 6)
)
)
)
hll
)
;;=================================子函数开始=================================
;;名称: h_lxdd
;;功能: 连续母线端点
;;输入: 端点方向
;;返回: 下一端点
(defun h_lxdd (pds fx hljj / p1 p2 lxl pde e hs smxal)
(setq pde nil)
(setq smxal (ssget "x" '((8 . "mx"))))
(if(or (= fx 0) (= fx 2))
(setq lxl (list (car pds)))
(setq lxl (list (cadr pds)))
)
(while (setq e (ssname smxal 0))
(setq p1 (cdr (assoc 10 (entget e)))
p2 (cdr (assoc 10 (reverse (entget e))))
)
(if (or (= fx 0) (= fx 2))
(if (and (equal (cadr p1) (cadr pds) 0.001)
(equal (cadr p2) (cadr pds) 0.001)
)
(if (> (setq hs (max (car p1) (car p2))) (car pds))
(setq lxl (cons hs lxl))
)
)
(if (and (equal (car p1) (car pds) 0.001)
(equal (car p2) (car pds) 0.001)
)
(if (> (setq hs (max (cadr p1) (cadr p2))) (cadr pds))
(setq lxl (cons hs lxl))
)
)
)
(ssdel e smxal)
)
(if(> (length lxl) 1)
(setq lxl (qsort h_comp lxl))
)
(while (and (> (length lxl) 1)
(< (- (cadr lxl) (car lxl)) (* 1.5 hljj))
)
(setq lxl (cdr lxl))
(if (or (= fx 0) (= fx 2))
(setq pde (list(car lxl)(cadr pds) 0.0))
(setq pde (list(car pds)(car lxl) 0.0))
)
)
pde
)
;;=================================子函数开始=================================
;;名称: h_lxxz
;;功能: 连续回路选择,选择由一点开始的所有连续同方向回路
;;输入: 开始点结束点方向
;;返回: 选择集
(defun h_lxxz (pds pde fx / p1 p2 ss i ls emx dqw1 wzpdt)
(setq ss nil)
(if (and pds pde)
(progn
(cond
((= fx 0)
(setq p1 (polar pds (* 1.5 pi) (* 90 tscale))
p2 (polar pde (* 0.5 pi) (* 2 tscale))
)
)
((= fx 1)
(setq p1 (polar pds pi (* 2 tscale))
p2 (polar pde 0 (* 90 tscale))
)
)
((= fx 2)
(setq p1 (polar pds (* 1.5 pi) (* 2 tscale))
p2 (polar pde (* 0.5 pi) (* 90 tscale))
)
)
((= fx 3)
(setq p1 (polar pds pi (* 90 tscale))
p2 (polar pde 0 (* 2 tscale))
)
)
)
(setq dqw1 (XScjx))
(if (or (= (h_inwi p1 (car dqw1) (cadr dqw1)) 1)
(= (h_inwi p2 (car dqw1) (cadr dqw1)) 1)
)
(progn
(command "_.zoom"
(list (min (car p1) (caar dqw1))
(min (cadr p1) (cadar dqw1))
)
(list (max (car p2) (caadr dqw1))
(max (cadr p2) (cadadr dqw1))
)
)
)
)
(setq ss (ssget "c" p1 p2 '((8 . "mx,bxt,fah,xhgg,xmdh"))))
(setq i 0
ls (sslength ss)
)
(repeat ls
(setq emx (ssname ss i))
(setq wzpdt (h_wzpd emx p1 p2 ss))
(if (or (null wzpdt) (= wzpdt t))
(ssdel emx ss)
(setq i (1+ i))
)
)
)
)
ss
)
;;=================================子函数开始=================================
;;名称: h_hlhz
;;功能: 回路绘制
;;输入: 回路起始点方向回路间距
;;返回: 无
(defun h_hlhz(pjd fx dist data1 data2 sm2 / zdist pds pdmx2 pdmx1 mxkd shu)
(setq zdist (* sm2 dist))
(Xsetin "Hlklib" "Hlkjj" (rtos (/ dist tscale) 2 2) 1)
(shldy pjd fx data1 data2) ;回路绘制
(command "_.color" "_green")
(command "_.Layer" "_m" "mx" "_c" 3 "" "")
(if (or (= fx 0) (= fx 2))
(setq pds (polar pjd 0 (* -0.5 zdist)))
(setq pds (polar pjd (* 0.5 pi) (* -0.5 zdist)))
)
(setq pdmx1 pds)
(repeat sm2
(if (or (= fx 0) (= fx 2))
(setq pdmx2 (polar pdmx1 0 dist))
(setq pdmx2 (polar pdmx1 (* 0.5 pi) dist))
)
(setq mxkd (atof (Xgetin "Hlklib" "Hlkmx" "0.6" 1)))
(setq mxkd (* mxkd tscale))
(command "_.pline" pdmx1 "_w" mxkd "" pdmx2 "")
(setq pdmx1 pdmx2)
) ;母线绘制
(setq shu(tblsearch "layer""GDXT"))
(if shu(command "_.layer" "_set" "GDXT" ""))
)
;;=================================子函数开始=================================
;;名称: h_sh2
;;功能: 回路互换
;;输入: 无
;;返回: 无
(defun h_sh2 (/ lll1 ph1 ph2 ttt1 hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 lll2 ttt2 pjd2
fx2 kd2 hlsm2 hlxzl2 ph3 ph4 lxfs slx pjdn1 pjd1n pjd2n e pme
smov1 smov2 smov pmds1 pmds1n pmds2 pmds2n pmde1 pmde2 jj1 jj2
sshl2 dist zxj ysj zxjn ysjn s2_ss3 s2_lsx mylist ss1 ss2 ss3
list1 list2 ylist1 ylist2 plist1 plist2 xlist1 xlist2 ess1 ess2
fan i fx shu)
;;=================================子函数开始=================================
;;名称: s2_ss3
;;功能: 同一回路中的元件互换时，所选两回路间的定货图
;;输入: pmds1 pme mylist
;;返回: ss
(defun s2_ss3(pmds1 pme mylist / ss point1 point2 point3 point4)
(setq point1(car mylist))
(setq point2(last mylist))
(setq point3(list(car pmds1)(cadr point1)(last point1)))
(setq point4(list(car pme)(cadr point2)(last point2)))
(setq ss(ssget "w" point3 point4))
)
;;=================================子函数开始=================================
;;名称: s2_lsx
;;功能: 滤表格线
;;输入: ss
;;返回: ss
(defun s2_lsx(ss / ename point1 point2 i elist name laye yanse ss1)
(setq i 0)
(setq ss1 (ssadd))
(repeat (sslength ss)
(setq ename(ssname ss i))
(setq elist(entget ename))
(setq name(cdr(assoc 0 elist)))
(setq laye(cdr(assoc 8 elist)))
(setq yanse(cdr(assoc 62 elist)))
(if(and(= name "LINE")(= laye "GDXT")(= yanse 3))(ssadd ename ss1))
(setq i(+ i 1))
)
(if(/=(sslength ss1)0)(setq ss(C_ssgl ss ss1)))
ss
)
;;h_sh2主函数开始
(setq zxj(car(XScjx)))
(setq ysj(last(XScjx)))
(setq lll1 t)
(while lll1
(command "_.undo" "_group")
(setq shu(tblsearch "layer""GDXT"))
(if shu(command "_.layer" "_set" "GDXT" ""))
(setq fan 1)
(prompt "\n请用窗口(W)选择互换回路(1):")
(setq ph1 1)
(while(not(listp ph1))
(initget 128)
(setq ph1 (getpoint "\n请输入窗口第一点<回车结束>:"))
)
(if ph1
(progn
(setq ttt1 t)
(while ttt1
(setq ph2 1)
(while(not(listp ph2))
(initget 128)
(setq ph2 (getcorner ph1 "\n请输入窗口第二点:"))
)
(if ph2
(progn
(setq hlxzl1 (h_xzhl ph1 ph2))
(if hlxzl1
(progn
(setq ttt1 nil)
(setq pjd1(nth 0 hlxzl1) fx1(nth 1 hlxzl1) kd1(nth 2 hlxzl1)
sshl1(nth 3 hlxzl1) hlsm1(nth 4 hlxzl1))
(setq i 0)
(repeat(sslength sshl1)(redraw(ssname sshl1 i)3)(setq i (1+ i)))
(setq lxfs 1 slx sshl1)
(setq lll2 t)
(while lll2
(prompt "\n请用窗口(W)选择互换回路(2):")
(setq ph3 1)
(while(not(listp ph3))
(initget 128)
(setq ph3 (getpoint "\n请输入窗口第一点<回车结束>:"))
)
(if ph3
(progn
(setq ttt2 t)
(while ttt2
(setq ph4 1)
(while (not(listp ph4))
(initget 128)
(setq ph4(getcorner ph3 "\n请输入窗口第二点:"))
)
(if ph4
(progn
(setq hlxzl2 (h_xzhl ph3 ph4))
(if hlxzl2
(progn
(setq pjd2(nth 0 hlxzl2) fx2(nth 1 hlxzl2) kd2(nth 2 hlxzl2)
sshl2(nth 3 hlxzl2) hlsm2(nth 4 hlxzl2))
(setq jj1(/ kd1 hlsm1) jj2(/ kd2 hlsm2))
(if(and(equal jj1 jj2 0.01)(= fx1 fx2))
(progn
(setq ttt2 nil lll2 nil)
(setq fx fx1)
(if(or(= fx 0)(= fx 2))
(setq pmds1(polar pjd1 0 (/ kd1 2.0))
pmds2(polar pjd2 0 (/ kd2 2.0))
)
(setq pmds1(polar pjd1(* 0.5 pi)(/ kd1 2.0))
pmds2(polar pjd2(* 0.5 pi)(/ kd2 2.0))
)
)
(setq pmde1(h_lxdd pmds1 fx jj1)
pmde2(h_lxdd pmds2 fx jj1)
)
(cond
((or(and(null pmde2)(equal pmde1 pmds2 0.01))
(and pmde1(equal pmde1 pmde2 0.01)
(>(distance2p pmds1 pmde1)
(distance2p pmds2 pmde2)
)
)
)
(if(or(= fx 0)(= fx 2))
(setq pjd1n (polar pjd1 0 (/ (- kd2 kd1) 2.0))
pjd2n (polar pjd2 0 (/ (- kd2 kd1) 2.0))
pmds1n (polar pmds1 0 (- kd2 kd1))
pme (polar pjd2 0 (* -0.5 kd2))
)
(setq pjd1n(polar pjd1(* 0.5 pi)(/(- kd2 kd1)2.0))
pjd2n(polar pjd2(* 0.5 pi)(/(- kd2 kd1)2.0))
pmds1n(polar pmds1(* 0.5 pi)(- kd2 kd1))
pme(polar pjd2(* 0.5 pi)(* -0.5 kd2))
)
)
(if(or(>(distance2p pmds1 pmde1)(+(distance2p pmds2 pmde1)kd2))
(equal(distance2p pmds1 pmde1)
(+(distance2p pmds2 pmde1)kd2)5)
)
(progn
(setq mylist (dhtss pjd1 2))
(if (and mylist(or (= fx1 0)(= fx1 2)))
(progn
(setq zxjn(car (XScjx)))
(setq ysjn(last (XScjx)))
(C_zoom mylist zxjn ysjn)
(setq ss1(last(C_ldel mylist pjd1 kd1 sshl1)))
(setq ss1(s2_lsx ss1))
(setq ss2(last(C_ldel mylist pjd2 kd2 sshl2)))
(setq ss2(s2_lsx ss2))
(if(not (equal pmds1 pme 0.01))
(progn
(setq smov(h_lxxz pmds1 pme fx))
(setq ss3(s2_ss3 pmds1 pme mylist))
(setq ss3(C_ssgl ss3 smov))
(setq ss3(s2_lsx ss3))
(if smove(command "_.move" smov "" pmds1 pmds1n))
(if ss3(command "_.move" ss3 "" pmds1 pmds1n))
)
)
(if sshl1(command "_.move" sshl1 "" pjd1 pjd2n))
(if ss1(command "_.move" ss1 "" pjd1 pjd2n))
(if sshl2(command "_.move" sshl2 "" pjd2 pjd1n))
(if ss2(command "_.move" ss2 "" pjd2 pjd1n))
(command "_.zoom" zxjn ysjn)
)
(progn
(if(not (equal pmds1 pme 0.01))
(progn
(setq smov(h_lxxz pmds1 pme fx))
(if smov(command "_.move" smov "" pmds1 pmds1n))
)
)
(if sshl1(command "_.move" sshl1 "" pjd1 pjd2n))
(if sshl2(command "_.move" sshl2 "" pjd2 pjd1n))
)
)
)
(Xacino "回路有交叉!" "操作错误" 6)
)
)
((or(and(null pmde1)(null pmde2)(equal pmds1 pmds2 0.01))
(and pmde1(equal pmde1 pmde2 0.01)
(equal pmds1 pmds2 0.01))
)
(Xacino "回路有交叉!" "操作错误" 6)
)
((or(and(null pmde1)(equal pmde2 pmds1 0.01))
(and pmde1(equal pmde1 pmde2 0.01)
(<(distance2p pmds1 pmde1)
(distance2p pmds2 pmde2))
)
)
(if(or(= fx 0)(= fx 2))
(setq pjd1n (polar pjd1 0 (/ (- kd1 kd2) 2.0))
pjd2n (polar pjd2 0 (/ (- kd1 kd2) 2.0))
pmds1n(polar pmds1 0 (- kd1 kd2))
pme (polar pjd1 0 (* -0.5 kd1))
)
(setq pjd1n (polar pjd1(* 0.5 pi)(/(- kd1 kd2)2.0))
pjd2n (polar pjd2(* 0.5 pi)(/(- kd1 kd2)2.0))
pmds1n(polar pmds1(* 0.5 pi)(- kd1 kd2))
pme (polar pjd1(* 0.5 pi)(* -0.5 kd1))
)
)
(if(or(<(+(distance2p pmds1 pmde2)kd1)
(distance2p pmds2 pmde2))
(equal(+ (distance2p pmds1 pmde2)kd1)
(distance2p pmds2 pmde2)5)
)
(progn
(setq mylist(dhtss pjd1 2))
(if (and mylist(or (= fx1 0)(= fx1 2)))
(progn
(setq zxjn(car (XScjx)))
(setq ysjn(last (XScjx)))
(C_zoom mylist zxjn ysjn)
(setq ss1(last(C_ldel mylist pjd1 kd1 sshl1)))
(setq ss1(s2_lsx ss1))
(setq ss2(last(C_ldel mylist pjd2 kd2 sshl2)))
(setq ss2(s2_lsx ss2))
(if(not (equal pmds2 pme 0.01))
(progn
(setq smov(h_lxxz pmds2 pme fx))
(setq ss3(s2_ss3 pmds2 pme mylist))
(setq ss3(C_ssgl ss3 smov))
(setq ss3(s2_lsx ss3))
(if smov(command "_.move" smov "" pmds1 pmds1n))
(if ss3(command "_.move" ss3 "" pmds1 pmds1n))
)
)
(if sshl1(command "_.move" sshl1 "" pjd1 pjd2n))
(if ss1(command "_.move" ss1 "" pjd1 pjd2n))
(if sshl2(command "_.move" sshl2 "" pjd2 pjd1n))
(if ss2(command "_.move" ss2 "" pjd2 pjd1n))
(command "_.zoom" zxjn ysjn)
)
(progn
(if(not (equal pmds2 pme 0.01))
(progn
(setq smov(h_lxxz pmds2 pme fx))
(if smov(command "_.move" smov "" pmds1 pmds1n))
)
)
(if sshl1(command "_.move" sshl1 "" pjd1 pjd2n))
(if sshl2(command "_.move" sshl2 "" pjd2 pjd1n))
)
)
)
(Xacino "回路有交叉!" "操作错误" 6)
)
)
(t
(if (or (= fx 0) (= fx 2))
(setq pjd1n (polar pjd1 0 (/ (- kd2 kd1)2.0))
pjd2n (polar pjd2 0 (/ (- kd1 kd2)2.0))
pmds1 (polar pjd1 0 (* 0.5 kd1))
pmds1n(polar pmds1 0(- kd2 kd1))
pmds2 (polar pjd2 0 (* 0.5 kd2))
pmds2n(polar pmds2 0(- kd1 kd2))
)
(setq pjd1n (polar pjd1(* 0.5 pi)(/(- kd2 kd1)2.0))
pjd2n (polar pjd2(* 0.5 pi)(/(- kd1 kd2)2.0))
pmds1 (polar pjd1(* 0.5 pi)(* 0.5 kd1))
pmds1n(polar pmds1(* 0.5 pi)(- kd2 kd1))
pmds2 (polar pjd2(* 0.5 pi)(* 0.5 kd2))
pmds2n(polar pmds2(* 0.5 pi)(- kd1 kd2))
)
)
(setq pmde1 (h_lxdd pmds1 fx jj1))
(setq smov1 (h_lxxz pmds1 pmde1 fx))
(setq pmde2 (h_lxdd pmds2 fx jj1))
(setq smov2 (h_lxxz pmds2 pmde2 fx))
(setq list1 (dhtss pjd1 2))
(setq list2 (dhtss pjd2 2))
(cond
((and(or(= fx 0)(= fx 2))list1(null list2))
(setq zxjn(car (XScjx)))
(setq ysjn(last (XScjx)))
(C_zoom list1 zxjn ysjn)
(setq ylist1(C_xyzb list1 pjd1 kd1))
(setq plist1(C_ldel list1 pjd1 kd1 sshl1))
(setq xlist1(C_movt plist1 kd1 kd2 sshl2 pjd2 pjd1n smov1 1))
(setq ess1 (last plist1))
(if ess1(command "_.erase" ess1 ""))
(if sshl1(command "_.move" sshl1 "" pjd1 pjd2n))
(if smov2(command "_.move" smov2 "" pmds2 pmds2n))
(C_slin (car xlist1) ylist1)
(C_slin (last xlist1) ylist1)
(C_hlin xlist1 ylist1 hlsm2)
(command "_.zoom" zxjn ysjn)
)
((and(or(= fx 0)(= fx 2))list2(null list1))
(setq zxjn(car (XScjx)))
(setq ysjn(last (XScjx)))
(C_zoom list2 zxjn ysjn)
(setq ylist2(C_xyzb list2 pjd2 kd2))
(setq plist2(C_ldel list2 pjd2 kd2 sshl2))
(setq xlist2(C_movt plist2 kd2 kd1 sshl1 pjd1 pjd2n smov2 1))
(setq ess2 (last plist2))
(if ess2(command "_.erase" ess2 ""))
(if sshl2(command "_.move" sshl2 "" pjd2 pjd1n))
(if smov1(command "_.move" smov1 "" pmds1 pmds1n))
(C_slin (car xlist2) ylist2)
(C_slin (last xlist2) ylist2)
(C_hlin xlist2 ylist2 hlsm1)
(command "_.zoom" zxjn ysjn)
)
((and(or(= fx 0)(= fx 2))list1 list2)
(setq zxjn(car (XScjx)))
(setq ysjn(last (XScjx)))
(C_zoom list2 zxjn ysjn)
(setq ylist2(C_xyzb list2 pjd2 kd2))
(setq plist2(C_ldel list2 pjd2 kd2 sshl2))
(setq xlist2(C_movt plist2 kd2 kd1 sshl1 pjd1 pjd2n smov2 1))
(C_zoom list1 zxjn ysjn)
(setq ylist1(C_xyzb list1 pjd1 kd1))
(setq plist1(C_ldel list1 pjd1 kd1 sshl1))
(setq xlist1(C_movt plist1 kd1 kd2 sshl2 pjd2 pjd1n smov1 1))
(setq ess2 (last plist2))
(setq ess1 (last plist1))
(if ess2(command "_.erase" ess2 ""))
(if ess1(command "_.erase" ess1 ""))
(C_slin (car xlist2) ylist2)
(C_slin (last xlist2) ylist2)
(C_hlin xlist2 ylist2 hlsm1)
(C_slin (car xlist1) ylist1)
(C_slin (last xlist1) ylist1)
(C_hlin xlist1 ylist1 hlsm2)
(command "_.zoom" zxjn ysjn)
)
(t
(if sshl1(command "_.move" sshl1 "" pjd1 pjd2n))
(if sshl2(command "_.move" sshl2 "" pjd2 Pjd1n))
(if smov1(command "_.move" smov1 "" pmds1 pmds1n))
(if smov2(command "_.move" smov2 "" pmds2 pmds2n))
)
)
)
)
)
(progn
(Xacino "所选回路的出线方向或间距不对,请重新选择!" "注意" 6)
(setq ttt2 nil)
)
)
)
(setq ttt2 nil)
)
)
)
)
)
(setq lll2 nil)
)
)
)
(setq ttt1 nil)
)
)
)
)
)
(setq lll1 nil)
)
(if(= lxfs 1)
(progn
(setq i 0)
(repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i)))
(setq lxfs 0)
)
)
(command "_.undo" "_end")
(setq fan 0)
)
)
;;================================子函数结束==================================
(_inidwg)
(princ "\n*回路互换*=Hlhh")
(setvar "plinetype" 2)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "pickadd" 1)
(setvar "osmode" 0)
(setvar "CECOLOR" "green")
(setq ucmark (getvar "worlducs"))
(if (= ucmark 0)
(progn
(setq ucs_fo (getvar "ucsfollow"))
(if (= ucs_fo 1)(setvar "ucsfollow" 0))
(command "_.ucs" "_world")
)
)
(setq lxfs 0 tscale(atof(xrddic "Tabscale" "100")) dqw(XScjx))
(setq o_para(xgetin "Hlklib" "Hlkpara" "" 1)
o_mes(xgetin "Hlklib" "RetHlkMes" "" 1)
o_jj(xgetin "Hlklib" "Hlkjj" "30" 1)
)
(menucmd "s=hd25l")
(h_sh2)
(if(= ucmark 0)(command "_.ucs" "_prev"))
(setvar "highlight" 1)
(setq dqwn(XScjx))
(if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw)))
(setq *error* olderr olderr nil)
(_resdwg)
(princ)
)
;;=================================主程序开始=================================
;;名称：C:HLINS
;;功能：简版回路编辑-回路插入
;;输入：无
;;返回：无
(defun C:HLINS(/ tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo
h_sh3 h_XZHL h_WZYZ h_HLHZ h_LXDD h_WZPD h_LXXZ h_mxwz h_inwi
h_comp C_zoom C_ssgl C_xyzb C_ldel C_movt C_movk C_hlin C_slin
s_px)
(setq olderr *error*)
;;=================================子函数开始=================================
;;名称：*error*(错误处理函数)
;;功能：当程序发生错误或用户中断时，平静地退出，并还原状态。
;;输入：无
;;返回：无
(defun *error* (msg / each)
(if (= fan 1)(command "_.undo" "_end"))
(if (= fan 1)(command "_.undo" ""))
(if (= ucmark 0) (command "_.ucs" "_prev"))
(xsetin "Hlklib" "Hlkpara" o_para 1)
(xsetin "Hlklib" "RetHlkMes" o_mes 1)
(xsetin "Hlklib" "Hlkjj" o_jj 1)
(if(= lxfs 1)
(progn(setq i 0)(repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i))))
)
(setq dqwn (XScjx))
(if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw)))
(foreach each
'(tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo h_sh3 h_xzhl
h_wzyz h_hlhz h_lxdd h_wzpd h_lxxz h_mxwz h_inwi h_comp C_zoom C_ssgl C_xyzb
C_ldel C_movt C_movk C_hlin C_slin point1 point2 i ename point3 point4 ss
elist point5 point6 biao ylist plist l xlist n nylist s_px yy list1 list2 a b
emx p1 p2 p3 pd1 pd2 pc mxwzt wzt npd1 npd2 es sins first fxhsf hszf pmxd1
pmxd2 fxhs hsz wzyz ssfah fah pjd fx sshl hlsm kd hll smx mxt len1 ii iii mxmin
mxmax i4 pcl e pcxl pcyl pcc xzt len2 pds hljj lxl pde hs smxal ls dqw1 wzpdt
dist data1 data2 sm2 zdist pdmx2 mxkd lll1 ph1 ph2 ttt1 hlxzl lll2 ttt2 ph3 ph4
slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj jjn hldata smov zxj
ysj zxjn ysjn mylist ess fan name laye yanse hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 pjd2
fx2 kd2 hlsm2 hlxzl2 pjdn1 pjd1n pjd2n pme smov1 smov2 pmds1 pmds1n pmds2 pmds2n
pmde1 pmde2 jj1 jj2 sshl2 ss1 ss2 ss3 ylist1 ylist2 plist1 plist2 xlist1 xlist2
ess1 ess2 point shu xzb)
(set each nil)
)
(setq each nil)
(setq *error* olderr olderr nil)
(_resdwg)
(princ)
)
;;=================================子函数开始=================================
;;名称：C_zoom
;;功能：判断是否zoom
;;输入：mylist-订货图的角表 zxj-视区左下角 ysj-视区右上角
;;返回：无
(defun C_zoom(mylist zxjn ysjn / point1 point2)
(setq point1(car mylist))
(setq point2(last mylist))
(if(or(>(car zxjn)(car point2))(<(car ysjn)(car point1))
(>(cadr zxjn)(cadr point1))(<(cadr ysjn)(cadr point2))
)
(command "_.ZOOM" "_w" point1 point2)
)
)
;;=================================子函数开始=================================
;;名称：C_ssgl
;;功能：过滤选择集
;;输入：ss1-选择集1 ss2-选择集2
;;返回：ss1
(defun C_ssgl(ss1 ss2 / i ename)
(setq i 0)
(repeat(sslength ss2)
(setq ename (ssname ss2 i))
(ssdel ename ss1)
(setq i (+ i 1))
)
ss1
)
;;=================================子函数开始=================================
;;名称：C_xyzb
;;功能：得到所选回路所有横线的Y坐标点集
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长
;;返回：ylist-所选回路所有横线的Y坐标表
(defun C_xyzb(mylist pjd kd / point1 point2 point3 point4 i ss ename elist
point5 point6 biao ylist)
(setq ylist '())
(setq point1(car mylist))
(setq point2(last mylist))
(setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2)))
(setq point4(list(+(car point3)kd)(cadr point1)(last point1)))
(setq ss (ssget "W" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3))))
(setq i 0)
(repeat (sslength ss)
(setq ename (ssname ss i))
(setq elist (entget ename))
(setq point5(cdr(assoc 10 elist)))
(setq point6(cdr(assoc 11 elist)))
(if (equal(cadr point5)(cadr point6)0.1)
(progn
(setq biao(member (cadr point5) ylist))
(if (not biao)
(setq ylist(cons (cadr point5) ylist))
)
)
)
(setq i (+ i 1))
)
ylist
)
;;=================================子函数开始=================================
;;名称：C_ldel
;;功能：得到所选回路列的左上角和右下角
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 sshl-回路选择集
;;返回：plist-点表(所选回路列的右上角、订货图的右下角和所选回路列的选择集)
(defun C_ldel(mylist pjd kd sshl / point1 point2 point3 point4 point5 ss plist)
(setq point1(car mylist))
(setq point2(last mylist))
(setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2)))
(setq point4(list(+(car pjd)(/ kd 2))(cadr point1)(last point2)))
(setq ss(ssget "w" point3 point4))
(setq ss(C_ssgl ss sshl))
(setq point5(list(car point4)(cadr point2)(last point2)))
(setq plist (list point5 point1 ss))
)
;;=================================子函数开始=================================
;;名称：C_movt
;;功能：copy回路并移动表格(从当前图中copy或move)
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度
;; sshln-替换回路 pjdf-替换回路的基点 pjd-被替回路的基点 smov-回路选择集
;; a-为0时拷贝,为1时移动,为2时插入
;;返回：xlist-新回路列的x坐标
(defun C_movt(plist kd kdn sshln pjdf pjdn smov a / point1 point2 l point3 point4 xlist ss)
(setq point1(car plist))
(setq point2(cadr plist))
(if(or(= a 0)(= a 1))
(progn
(setq l(- kd kdn))
(setq point3(list(-(car point1)l)(cadr point1)(last point1)))
(setq ss(ssget "w" point1 point2))
(if (= a 0)
(command "_.copy" sshln "" pjdf pjdn)
(command "_.move" sshln "" pjdf pjdn)
)
(if smov
(progn
(command "_.move" smov "" point1 point3)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point1 point3)
(setq xlist(list(-(car point1)kd)(car point3)))
)
(progn
(setq point3(list(-(car point1)kd)(cadr point1)(last point1)))
(setq point4(list(+(car point3)kdn)(cadr point3)(last point3)))
(setq ss (ssget "w" point3 point2))
(command "_.copy" sshln "" pjdf pjdn)
(if smov
(progn
(command "_.move" smov "" point3 point4)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point3 point4)
(setq xlist(list(car point3)(car point4)))
)
)
xlist
)
;;=================================子函数开始=================================
;;名称：C_movk
;;功能：copy回路并移动表格(从图库中取)
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度
;; pjdn-替换回路 fx-回路方向 dist、data1、data2、sm2-调回路库的参数 smov-回路选择集
;; a-为时替换回路,为2时插入回路
;;返回：xlist-新回路列的两个x坐标
(defun C_movk(plist kd kdn pjdn fx dist data1 data2 sm2 smov a / point1 point2 l point3
point4 xlist ss)
(setq point1(car plist))
(setq point2(cadr plist))
(if (= a 1)
(progn
(setq l(- kd kdn))
(setq point3(list(-(car point1)l)(cadr point1)(last point1)))
(setq ss(ssget "w" point1 point2))
(h_hlhz pjdn fx dist data1 data2 sm2)
(if smov
(progn
(command "_.move" smov "" point1 point3)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point1 point3)
(setq xlist(list(-(car point1)kd)(car point3)))
)
(progn
(setq point3(list(-(car point1)kd)(cadr point1)(last point1)))
(setq point4(list(+(car point3)kdn)(cadr point3)(last point3)))
(setq ss (ssget "w" point3 point2))
(h_hlhz pjdn fx dist data1 data2 sm2)
(if smov
(progn
(command "_.move" smov "" point3 point4)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point3 point4)
(setq xlist(list(car point3)(car point4)))
)
)
xlist
)
;;=================================子函数开始=================================
;;名称：C_hlin
;;功能：画横线
;;输入：xlist-新订货图的x坐标表 ylist-所选订货图所有横线的Y坐标表 hlsm-回路数目
;;返回：无
(defun C_hlin(xlist ylist hlsm / point1 point2 i l n)
(setq i 0)
(setq l(/(abs(-(car xlist)(last xlist)))hlsm))
(repeat (length ylist)
(setq n 0)
(repeat hlsm
(setq point1(list(+(car xlist)(* l n))(nth i ylist)0.0))
(setq point2(list(+(car xlist)(* l (+ n 1)))(nth i ylist)0.0))
(command "_.line" point1 point2 "")
(setq n (+ n 1))
)
(setq i (+ i 1))
)
)
;;=================================子函数开始=================================
;;名称：s_px
;;功能：排序(从大到小)
;;输入：ylist-所选订货图所有横线的Y坐标表
;;返回：nylist
(defun s_px(ylist / i nylist yy list1 list2)
(setq nylist '())
(while (/= (length ylist) 0)
(setq i 1)
(setq yy (nth 0 ylist))
(repeat (-(length ylist)1)
(if (> yy (nth i ylist))
(setq yy (nth i ylist))
)
(setq i (+ i 1))
)
(setq nylist (cons yy nylist))
(setq list1 (cdr (member yy ylist)))
(setq list2 (cdr (member yy (reverse ylist))))
(setq ylist (append list1 list2))
)
nylist
)
;;=================================子函数开始=================================
;;名称：C_slin
;;功能：画竖线
;;输入：xzb-x坐标 ylist-所选订货图所有横线的Y坐标表
;;返回：无
(defun C_slin(xzb ylist / nylist point1 point2 i)
(setq i 0)
(setq nylist(s_px ylist))
(repeat (-(length nylist)1)
(setq point1(list xzb (nth i nylist)))
(setq point2(list xzb (nth (+ i 1) nylist)))
(command "_.line" point1 point2 "")
(setq i (+ i 1))
)
)
;;=================================子函数开始=================================
;;名称：h_comp
;;功能：计算两值的差(用于排序)
;;输入：a、b
;;返回：两值的差
(defun h_comp (a b)
(- a b)
)
;;=================================子函数开始=================================
;;名称: h_inwi
;;功能: 判断p1是否在p2 p3组成的窗口内
;;输入: p1 p2 p3
;;返回: 0-在窗口内、1-在窗口外、nil-边界上
(defun h_inwi (p1 p2 p3)
(cond
((and(< (car p1) (- (max (car p2) (car p3)) tscale))
(> (car p1) (+ (min (car p2) (car p3)) tscale))
(< (cadr p1) (- (max (cadr p2) (cadr p3)) tscale))
(> (cadr p1) (+ (min (cadr p2) (cadr p3)) tscale))
)
0
)
((or(> (car p1) (+ (max (car p2) (car p3)) tscale))
(< (car p1) (- (min (car p2) (car p3)) tscale))
(> (cadr p1) (+ (max (cadr p2) (cadr p3)) tscale))
(< (cadr p1) (- (min (cadr p2) (cadr p3)) tscale))
)
1
)
(t nil)
)
)
;;=================================子函数开始=================================
;;名称: h_mxwz
;;功能: 母线位置判断
;;输入: emx p1 p2
;;返回: mxwzt
(defun h_mxwz (emx p1 p2 / pd1 pd2 pc mxwzt)
(setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0)))
(if (or (> (car pc) (max (car p1) (car p2)))
(> (cadr pc) (max (cadr p1) (cadr p2)))
(< (car pc) (min (car p1) (car p2)))
(< (cadr pc) (min (cadr p1) (cadr p2)))
)
(setq mxwzt nil)
(setq mxwzt pc)
)
mxwzt
)
;;=================================子函数开始=================================
;;名称: h_wzpd
;;功能: 位置判断、判断实体（块-插入点，线-二端点）是否在窗口之内
;;输入: 实体名窗口二角点
;;返回: 在窗口内-中点
;; 不在窗口内-T
;; 交叉(线)-nil
(defun h_wzpd (emx p1 p2 ss / pd1 pd2 pc wzt npd1 npd2 es sins i)
(cond
((= (cdr (assoc 0 (entget emx))) "LWPOLYLINE")
(setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0)))
(setq npd1 (h_inwi pd1 p1 p2)
npd2 (h_inwi pd2 p1 p2)
)
(cond
((or(and (= npd1 0) (= npd2 1))(and (= npd2 0) (= npd1 1)))
(setq wzt nil)
)
((or (= npd1 1) (= npd2 1))
(setq wzt t)
)
(t (setq wzt pc))
)
)
(t
(setq pc (cdr (assoc 10 (entget emx))))
(cond
((= (h_inwi pc p1 p2) 1)
(setq wzt t)
)
((null (h_inwi pc p1 p2))
(if (= (cdr (assoc 0 (entget emx))) "insert")
(progn
(setq sins (ssget "c"
(polar pc (* 0.25 pi) tscale)
(polar pc (* 0.25 pi) tscale)
'((0 . "insert,lwpolyline"))
)
)
(setq wzt pc
i 0
)
(while (and wzt (< i (sslength sins)))
(setq es (ssname sins i))
(if (not (ssmemb es sins))
(setq wzt t)
(setq i (1+ i))
)
)
)
(setq wzt pc)
)
)
(t (setq wzt pc))
)
)
)
wzt
)
;;=================================子函数开始=================================
;;名称: h_wzyz
;;功能: 母线位置一致性判断
;;输入: 母线循环号 (方向初值坐标初值)
;;返回: i=0 (方向坐标)
;; i/=0 位置一致 t
;; 位置不一致 nil
(defun h_wzyz (emx i first / fxhsf hszf pmxd1 pmxd2 fxhs hsz wzyz)
(setq fxhsf (car first)
hszf (cadr first)
)
(setq pmxd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pmxd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(if(equal (car pmxd1) (car pmxd2) 0.001)
(setq fxhs 1 hsz (car pmxd1))
(setq fxhs 0 hsz (cadr pmxd1))
)
(if(= i 0)
(setq wzyz (list fxhs hsz))
(progn
(if (or(not (equal fxhs fxhsf 0.01))
(not (equal hsz hszf 0.01))
)
(setq wzyz nil)
(setq wzyz t)
)
)
)
wzyz
)
;;=================================子函数开始=================================
;;名称: h_xzhl
;;功能: 选择回路
;;输入: 窗口二角点p1，p2
;;返回: t-(基点方向? 宽度回路选择集回路数) 方向--0 向下 1 向右 2 向上 3 向左
;; NIL-nil
(defun h_xzhl (p1 p2 / ssfah fah pjd fx sshl hlsm
kd hll smx i mxt fxhs hsz len1 ii
emx iii pd1 pd2 mxmin mxmax p1 p2 pc
ss i4 pcl first e pcxl pcyl pcc xzt
len2
)
(setq hll nil)
(setq smx (ssget "c" p1 p2 '((0 . "lwpolyline") (8 . "mx"))))
(if smx
(progn
(setq i 0 mxt t)
(while (and mxt (< i (sslength smx)))
(setq emx (ssname smx i))
(if (= i 0)
(setq first (h_wzyz emx 0 nil))
(setq mxt (h_wzyz emx i first))
)
(setq i (1+ i))
) ;判断母线位置一致性
(if mxt
(progn
(setq fxhs (car first)
hsz (cadr first)
ii 0
len1 (sslength smx)
)
(repeat len1
(setq emx (ssname smx ii))
(if (h_mxwz emx p1 p2)
(setq ii (1+ ii))
(ssdel emx smx)
)
) ;删除中心在边界外的母线
(setq hlsm (sslength smx))
(if (/= hlsm 0)
(progn
(setq iii 0)
(repeat hlsm
(setq emx (ssname smx iii))
(setq pd1 (cdr (assoc 10 (entget emx)))
pd2 (cdr (assoc 10 (reverse (entget emx))))
)
(if (= fxhs 0)
(if (= iii 0)
(setq mxmin (min (car pd1) (car pd2))
mxmax (max (car pd1) (car pd2))
)
(progn
(if (< (min (car pd1) (car pd2)) mxmin)
(setq mxmin (min (car pd1) (car pd2)))
)
(if (> (max (car pd1) (car pd2)) mxmax)
(setq mxmax (max (car pd1) (car pd2)))
)
)
)
(if (= iii 0)
(setq mxmin (min (cadr pd1) (cadr pd2))
mxmax (max (cadr pd1) (cadr pd2))
)
(progn
(if (< (min (cadr pd1) (cadr pd2)) mxmin)
(setq mxmin (min (cadr pd1) (cadr pd2)))
)
(if (> (max (cadr pd1) (cadr pd2)) mxmax)
(setq mxmax (max (cadr pd1) (cadr pd2)))
)
)
)
)
(setq iii (1+ iii))
)
(setq kd (- mxmax mxmin))
(if (= fxhs 0)
(setq p1 (list mxmin (cadr p1) 0.0)
p2 (list mxmax (cadr p2) 0.0)
pjd (list (/ (+ mxmin mxmax) 2) hsz 0.0)
)
(setq p1 (list (car p1) mxmin 0.0)
p2 (list (car p2) mxmax 0.0)
pjd (list hsz (/ (+ mxmin mxmax) 2) 0.0)
)
) ;取得母线范围并更新选择集窗口
(setq ss (ssget "c" p1 p2 '((8 . "mx,fah,bxt,xhgg,xmdh"))))
(setq i4 0
pcl nil
len2 (sslength ss)
xzt t
)
(while (and xzt (< i4 len2))
(setq e (ssname ss i4))
(if (setq pc (h_wzpd e p1 p2 smx))
(progn
(if (= pc t)
(progn
(ssdel e ss)
(setq len2 (1- len2))
)
(progn
(setq pcl (cons pc pcl))
(setq i4 (1+ i4))
)
)
)
(setq xzt nil)
)
)
;去掉多余实体,如果交叉结束
(if xzt
(progn
(setq pcxl (mapcar 'car pcl)
pcyl (mapcar 'cadr pcl)
)
(setq pcc (list (/ (apply '+ pcxl) (length pcl))
(/ (apply '+ pcyl) (length pcl))
0.0
)
)
(if (= fxhs 0)
(if (< (cadr pcc) (cadr pjd))
(setq fx 0)
(setq fx 2)
)
(if (> (car pcc) (car pjd))
(setq fx 1)
(setq fx 3)
)
)
(setq hll (list pjd fx kd ss hlsm))
)
(Xacino "回路选择不完整!" "操作错误" 6)
)
)
)
)
(Xacino "选了其他回路的母线!" "操作错误" 6)
)
)
)
hll
)
;;=================================子函数开始=================================
;;名称: h_lxdd
;;功能: 连续母线端点
;;输入: 端点方向
;;返回: 下一端点
(defun h_lxdd (pds fx hljj / p1 p2 lxl pde e hs smxal)
(setq pde nil)
(setq smxal (ssget "x" '((8 . "mx"))))
(if(or (= fx 0) (= fx 2))
(setq lxl (list (car pds)))
(setq lxl (list (cadr pds)))
)
(while (setq e (ssname smxal 0))
(setq p1 (cdr (assoc 10 (entget e)))
p2 (cdr (assoc 10 (reverse (entget e))))
)
(if (or (= fx 0) (= fx 2))
(if (and (equal (cadr p1) (cadr pds) 0.001)
(equal (cadr p2) (cadr pds) 0.001)
)
(if (> (setq hs (max (car p1) (car p2))) (car pds))
(setq lxl (cons hs lxl))
)
)
(if (and (equal (car p1) (car pds) 0.001)
(equal (car p2) (car pds) 0.001)
)
(if (> (setq hs (max (cadr p1) (cadr p2))) (cadr pds))
(setq lxl (cons hs lxl))
)
)
)
(ssdel e smxal)
)
(if(> (length lxl) 1)
(setq lxl (qsort h_comp lxl))
)
(while (and (> (length lxl) 1)
(< (- (cadr lxl) (car lxl)) (* 1.5 hljj))
)
(setq lxl (cdr lxl))
(if (or (= fx 0) (= fx 2))
(setq pde (list(car lxl)(cadr pds) 0.0))
(setq pde (list(car pds)(car lxl) 0.0))
)
)
pde
)
;;=================================子函数开始=================================
;;名称: h_lxxz
;;功能: 连续回路选择,选择由一点开始的所有连续同方向回路
;;输入: 开始点结束点方向
;;返回: 选择集
(defun h_lxxz (pds pde fx / p1 p2 ss i ls emx dqw1 wzpdt)
(setq ss nil)
(if (and pds pde)
(progn
(cond
((= fx 0)
(setq p1 (polar pds (* 1.5 pi) (* 90 tscale))
p2 (polar pde (* 0.5 pi) (* 2 tscale))
)
)
((= fx 1)
(setq p1 (polar pds pi (* 2 tscale))
p2 (polar pde 0 (* 90 tscale))
)
)
((= fx 2)
(setq p1 (polar pds (* 1.5 pi) (* 2 tscale))
p2 (polar pde (* 0.5 pi) (* 90 tscale))
)
)
((= fx 3)
(setq p1 (polar pds pi (* 90 tscale))
p2 (polar pde 0 (* 2 tscale))
)
)
)
(setq dqw1 (XScjx))
(if (or (= (h_inwi p1 (car dqw1) (cadr dqw1)) 1)
(= (h_inwi p2 (car dqw1) (cadr dqw1)) 1)
)
(progn
(command "_.zoom"
(list (min (car p1) (caar dqw1))
(min (cadr p1) (cadar dqw1))
)
(list (max (car p2) (caadr dqw1))
(max (cadr p2) (cadadr dqw1))
)
)
)
)
(setq ss (ssget "c" p1 p2 '((8 . "mx,bxt,fah,xhgg,xmdh"))))
(setq i 0
ls (sslength ss)
)
(repeat ls
(setq emx (ssname ss i))
(setq wzpdt (h_wzpd emx p1 p2 ss))
(if (or (null wzpdt) (= wzpdt t))
(ssdel emx ss)
(setq i (1+ i))
)
)
)
)
ss
)
;;=================================子函数开始=================================
;;名称: h_hlhz
;;功能: 回路绘制
;;输入: 回路起始点方向回路间距
;;返回: 无
(defun h_hlhz(pjd fx dist data1 data2 sm2 / zdist pds pdmx2 pdmx1 mxkd shu)
(setq zdist (* sm2 dist))
(Xsetin "Hlklib" "Hlkjj" (rtos (/ dist tscale) 2 2) 1)
(shldy pjd fx data1 data2) ;回路绘制
(command "_.color" "_green")
(command "_.Layer" "_m" "mx" "_c" 3 "" "")
(if (or (= fx 0) (= fx 2))
(setq pds (polar pjd 0 (* -0.5 zdist)))
(setq pds (polar pjd (* 0.5 pi) (* -0.5 zdist)))
)
(setq pdmx1 pds)
(repeat sm2
(if (or (= fx 0) (= fx 2))
(setq pdmx2 (polar pdmx1 0 dist))
(setq pdmx2 (polar pdmx1 (* 0.5 pi) dist))
)
(setq mxkd (atof (Xgetin "Hlklib" "Hlkmx" "0.6" 1)))
(setq mxkd (* mxkd tscale))
(command "_.pline" pdmx1 "_w" mxkd "" pdmx2 "")
(setq pdmx1 pdmx2)
) ;母线绘制
(setq shu(tblsearch "layer""GDXT"))
(if shu(command "_.layer" "_set" "GDXT" ""))
)
;;=================================子函数开始=================================
;;名称: h_sh3
;;功能: 回路插入
;;输入: 无
;;返回: 无
(defun h_sh3(/ lll1 ph1 ph2 ttt1 hlxzl pjd fx kd sshl hlsm lll2 ttt2 ph3 ph4
lxfs slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde
jj jjn sshl hldata i data1 data2 dist sm2 smov zxj ysj zxjn ysjn
mylist ylist plist xlist fan shu)
(setq zxj(car(XScjx)))
(setq ysj(last(XScjx)))
(setq lll1 t)
(while lll1
(command "_.undo" "_group")
(setq shu(tblsearch "layer""GDXT"))
(if shu(command "_.layer" "_set" "GDXT" ""))
(setq fan 1)
(prompt"\n请用窗口(W)选择回路(在所选回路的左边或下边插入):")
(setq ph1 1)
(while(not(listp ph1))
(initget 128)
(setq ph1 (getpoint "\n请输入窗口第一点<回车结束>:"))
)
(if ph1
(progn
(setq ttt1 t)
(while ttt1
(setq ph2 1)
(while(not(listp ph2))
(initget 128)
(setq ph2 (getcorner ph1 "\n请输入窗口第二点:"))
)
(if ph2
(progn
(setq hlxzl (h_xzhl ph1 ph2))
(if hlxzl
(progn
(setq ttt1 nil i 0)
(setq pjd (nth 0 hlxzl)
fx (nth 1 hlxzl)
kd (nth 2 hlxzl)
sshl (nth 3 hlxzl)
hlsm (nth 4 hlxzl)
)
(repeat(sslength sshl)(redraw(ssname sshl i)3)(setq i(1+ i)))
(setq lxfs 1 slx sshl)
(if(=(IfWndVis "hlklibclass") 0)
(hlklib 0 1 "s" 0 1 1 0 0)
(progn
(xsetin "Hlklib" "Hlkpara" "0&1&0&1&1&0&0" 1)
(xsetin "Hlklib" "RetHlkMes" "s" 1)
)
)
(setq lll2 t)
(while lll2
(prompt "\n请用窗口(W)或从图库选择插入回路:")
(setq ph3 1)
(while(and(/= ph3 "s")(not(listp ph3)))
(initget 128 "s")
(setq ph3(getpoint"\n请输入窗口第一点或请选取方案<回车结束>:"))
)
(cond
((and ph3 (listp ph3))
(setq ttt2 t)
(while ttt2
(setq ph4 1)
(while(not(listp ph4))
(initget 128)
(setq ph4 (getcorner ph3 "\n请输入窗口第二点:"))
)
(if ph4
(progn
(setq hlxzln (h_xzhl ph3 ph4))
(if hlxzln
(progn
(setq pjdf(nth 0 hlxzln) fxn(nth 1 hlxzln) kdn(nth 2 hlxzln)
sshln(nth 3 hlxzln) hlsmn(nth 4 hlxzln))
(setq jj(/ kd hlsm) jjn(/ kdn hlsmn))
(if(and(equal jj jjn 0.01)(= fx fxn))
(progn
(setq ttt2 nil lll2 nil)
(if(or(= fx 0)(= fx 2))
(setq pjdn(polar pjd 0(/(- kdn kd)2.0))
pmds(polar pjd 0(/ kd -2.0))
pmdsn(polar pmds 0 kdn)
)
(setq pjdn(polar pjd (* 0.5 pi)(/(- kdn kd)2.0))
pmds(polar pjd(* 0.5 pi)(/ kd -2.0))
pmdsn(polar pmds(* 0.5 pi) kdn)
)
)
(setq pmde (h_lxdd pmds fx jj))
(setq smov (h_lxxz pmds pmde fx))
(setq mylist(dhtss pjd 2))
(if(and mylist(or(= fx 0)(= fx 2)))
(progn
(setq zxjn(car(XScjx)))
(setq ysjn(last(XScjx)))
(C_zoom mylist zxjn ysjn)
(setq ylist(C_xyzb mylist pjd kd))
(setq plist(C_ldel mylist pjd kd sshl))
(setq xlist(C_movt plist kd kdn sshln pjdf pjdn smov 2))
(C_slin (car xlist) ylist)
(C_hlin xlist ylist hlsmn)
(command "_.zoom" zxj ysj)
)
(progn
(command "_.copy" sshln "" pjdf pjdn)
(if smov(command "_.move" smov "" pmds pmdsn))
)
)
)
(progn
(Xacino "所选回路的出线方向或间距不对,请重新选择!" "注意" 6)
(setq ttt2 nil)
)
)
)
(setq ttt2 nil)
)
)
)
)
)
((= ph3 "s")
(setq lll2 nil)
(setq hldata (xgetin "Hlklib" "Hlkdata" "" 1))
(setq data1(_getnS hldata 1 "&") data2(_getnS hldata 2 "&"))
(setq dist (/ kd hlsm))
(setq sm2 (fhlnum data1 data2))
(setq kdn (* sm2 dist))
(if (or (= fx 0) (= fx 2))
(setq pjdn (polar pjd 0 (/ (- kdn kd) 2.0))
pmds (polar pjd 0 (/ kd -2.0))
pmdsn (polar pmds 0 kdn)
)
(setq pjdn (polar pjd (* 0.5 pi) (/ (- kdn kd) 2.0))
pmds (polar pjd (* 0.5 pi) (/ kd -2.0))
pmdsn (polar pmds (* 0.5 pi) kdn)
)
)
(setq pmde (h_lxdd pmds fx dist))
(setq smov (h_lxxz pmds pmde fx))
(setq mylist(dhtss pjd 2))
(if(and mylist (or (= fx 0) (= fx 2)))
(progn
(setq zxjn(car(XScjx)))
(setq ysjn(last(XScjx)))
(C_zoom mylist zxjn ysjn)
(setq ylist(C_xyzb mylist pjd kd))
(setq plist(C_ldel mylist pjd kd sshl))
(setq xlist(C_movk plist kd kdn pjdn fx dist data1 data2 sm2 smov 2))
(C_slin (car xlist) ylist)
(C_hlin xlist ylist sm2)
(command "_.zoom" zxj ysj)
)
(progn
(if smov (command "_.move" smov "" pmds pmdsn))
(h_hlhz pjdn fx dist data1 data2 sm2)
)
)
)
(t (setq lll2 nil)) ;回车返回
)
) ;替换选取循环
)
(setq ttt1 nil)
)
)
)
)
)
(setq lll1 nil)
) ;是否ph1--t
(if(= lxfs 1)
(progn
(setq i 0)
(repeat (sslength slx)
(redraw (ssname slx i) 4)
(setq i (1+ i))
)
(setq lxfs 0)
)
)
(command "_.undo" "_end")
(setq fan 0)
) ;被替换选取循环
)
;;================================子函数结束==================================
(_inidwg)
(princ "\n*回路插入*=Hlins")
(setvar "plinetype" 2)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "pickadd" 1)
(setvar "osmode" 0)
(setvar "CECOLOR" "green")
(setq ucmark (getvar "worlducs"))
(if (= ucmark 0)
(progn
(setq ucs_fo (getvar "ucsfollow"))
(if (= ucs_fo 1)(setvar "ucsfollow" 0))
(command "_.ucs" "_world")
)
)
(setq lxfs 0 tscale(atof(xrddic "Tabscale" "100")) dqw(XScjx))
(setq o_para(xgetin "Hlklib" "Hlkpara" "" 1)
o_mes(xgetin "Hlklib" "RetHlkMes" "" 1)
o_jj(xgetin "Hlklib" "Hlkjj" "30" 1)
)
(menucmd "s=hd25l")
(h_sh3)
(if(= ucmark 0)(command "_.ucs" "_prev"))
(setvar "highlight" 1)
(setq dqwn(XScjx))
(if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw)))
(setq *error* olderr olderr nil)
(_resdwg)
(princ)
)
;;=================================主程序开始=================================
;;名称：C:HLDEL
;;功能：简版回路编辑-回路删除
;;输入：无
;;返回：无
(defun C:HLDEL(/ tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo
h_sh4 h_XZHL h_WZYZ h_HLHZ h_LXDD h_WZPD h_LXXZ h_mxwz h_inwi
h_comp C_zoom C_ssgl C_xyzb C_ldel C_movt C_movk C_hlin C_slin
s_px)
(setq olderr *error*)
;;=================================子函数开始=================================
;;名称：*error*(错误处理函数)
;;功能：当程序发生错误或用户中断时，平静地退出，并还原状态。
;;输入：无
;;返回：无
(defun *error* (msg / each)
(if (= fan 1)(command "_.undo" "_end"))
(if (= fan 1)(command "_.undo" ""))
(if (= ucmark 0) (command "_.ucs" "_prev"))
(xsetin "Hlklib" "Hlkpara" o_para 1)
(xsetin "Hlklib" "RetHlkMes" o_mes 1)
(xsetin "Hlklib" "Hlkjj" o_jj 1)
(if(= lxfs 1)
(progn(setq i 0)(repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i))))
)
(setq dqwn (XScjx))
(if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw)))
(foreach each
'(tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo h_sh4 h_xzhl
h_wzyz h_hlhz h_lxdd h_wzpd h_lxxz h_mxwz h_inwi h_comp C_zoom C_ssgl C_xyzb
C_ldel C_movt C_movk C_hlin C_slin point1 point2 i ename point3 point4 ss
elist point5 point6 biao ylist plist l xlist n nylist s_px yy list1 list2 a b
emx p1 p2 p3 pd1 pd2 pc mxwzt wzt npd1 npd2 es sins first fxhsf hszf pmxd1
pmxd2 fxhs hsz wzyz ssfah fah pjd fx sshl hlsm kd hll smx mxt len1 ii iii mxmin
mxmax i4 pcl e pcxl pcyl pcc xzt len2 pds hljj lxl pde hs smxal ls dqw1 wzpdt
dist data1 data2 sm2 zdist pdmx2 mxkd lll1 ph1 ph2 ttt1 hlxzl lll2 ttt2 ph3 ph4
slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj jjn hldata smov zxj
ysj zxjn ysjn mylist ess fan name laye yanse hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 pjd2
fx2 kd2 hlsm2 hlxzl2 pjdn1 pjd1n pjd2n pme smov1 smov2 pmds1 pmds1n pmds2 pmds2n
pmde1 pmde2 jj1 jj2 sshl2 ss1 ss2 ss3 ylist1 ylist2 plist1 plist2 xlist1 xlist2
ess1 ess2 point s4_xc s4_glx shu xzb)
(set each nil)
)
(setq each nil)
(setq *error* olderr olderr nil)
(_resdwg)
(princ)
)
;;=================================子函数开始=================================
;;名称：C_zoom
;;功能：判断是否zoom
;;输入：mylist-订货图的角表 zxj-视区左下角 ysj-视区右上角
;;返回：无
(defun C_zoom(mylist zxjn ysjn / point1 point2)
(setq point1(car mylist))
(setq point2(last mylist))
(if(or(>(car zxjn)(car point2))(<(car ysjn)(car point1))
(>(cadr zxjn)(cadr point1))(<(cadr ysjn)(cadr point2))
)
(command "_.ZOOM" "_w" point1 point2)
)
)
;;=================================子函数开始=================================
;;名称：C_ssgl
;;功能：过滤选择集
;;输入：ss1-选择集1 ss2-选择集2
;;返回：ss1
(defun C_ssgl(ss1 ss2 / i ename)
(setq i 0)
(repeat(sslength ss2)
(setq ename (ssname ss2 i))
(ssdel ename ss1)
(setq i (+ i 1))
)
ss1
)
;;=================================子函数开始=================================
;;名称：C_xyzb
;;功能：得到所选回路所有横线的Y坐标点集
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长
;;返回：ylist-所选回路所有横线的Y坐标表
(defun C_xyzb(mylist pjd kd / point1 point2 point3 point4 i ss ename elist
point5 point6 biao ylist)
(setq ylist '())
(setq point1(car mylist))
(setq point2(last mylist))
(setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2)))
(setq point4(list(+(car point3)kd)(cadr point1)(last point1)))
(setq ss (ssget "C" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3))))
(setq i 0)
(repeat (sslength ss)
(setq ename (ssname ss i))
(setq elist (entget ename))
(setq point5(cdr(assoc 10 elist)))
(setq point6(cdr(assoc 11 elist)))
(if (equal(cadr point5)(cadr point6)0.1)
(progn
(setq biao(member (cadr point5) ylist))
(if (not biao)
(setq ylist(cons (cadr point5) ylist))
)
)
)
(setq i (+ i 1))
)
ylist
)
;;=================================子函数开始=================================
;;名称：C_ldel
;;功能：得到所选回路列的左上角和右下角
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 sshl-回路选择集
;;返回：plist-点表(所选回路列的右上角、订货图的右下角和所选回路列的选择集)
(defun C_ldel(mylist pjd kd sshl / point1 point2 point3 point4 point5 ss plist)
(setq point1(car mylist))
(setq point2(last mylist))
(setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2)))
(setq point4(list(+(car pjd)(/ kd 2))(cadr point1)(last point2)))
(setq ss(ssget "w" point3 point4))
(setq ss(C_ssgl ss sshl))
(setq point5(list(car point4)(cadr point2)(last point2)))
(setq plist (list point5 point1 ss))
)
;;=================================子函数开始=================================
;;名称：C_movt
;;功能：copy回路并移动表格(从当前图中copy或move)
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度
;; sshln-替换回路 pjdf-替换回路的基点 pjd-被替回路的基点 smov-回路选择集
;; a-为0时拷贝,为1时移动,为2时插入
;;返回：xlist-新回路列的x坐标
(defun C_movt(plist kd kdn sshln pjdf pjdn smov a / point1 point2 l point3 point4 xlist ss)
(setq point1(car plist))
(setq point2(cadr plist))
(if(or(= a 0)(= a 1))
(progn
(setq l(- kd kdn))
(setq point3(list(-(car point1)l)(cadr point1)(last point1)))
(setq ss(ssget "w" point1 point2))
(if (= a 0)
(command "_.copy" sshln "" pjdf pjdn)
(command "_.move" sshln "" pjdf pjdn)
)
(if smov
(progn
(command "_.move" smov "" point1 point3)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point1 point3)
(setq xlist(list(-(car point1)kd)(car point3)))
)
(progn
(setq point3(list(-(car point1)kd)(cadr point1)(last point1)))
(setq point4(list(+(car point3)kdn)(cadr point3)(last point3)))
(setq ss (ssget "w" point3 point2))
(command "_.copy" sshln "" pjdf pjdn)
(if smov
(progn
(command "_.move" smov "" point3 point4)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point3 point4)
(setq xlist(list(car point3)(car point4)))
)
)
xlist
)
;;=================================子函数开始=================================
;;名称：C_movk
;;功能：copy回路并移动表格(从图库中取)
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度
;; pjdn-替换回路 fx-回路方向 dist、data1、data2、sm2-调回路库的参数 smov-回路选择集
;; a-为时替换回路,为2时插入回路
;;返回：xlist-新回路列的两个x坐标
(defun C_movk(plist kd kdn pjdn fx dist data1 data2 sm2 smov a / point1 point2 l point3
point4 xlist ss)
(setq point1(car plist))
(setq point2(cadr plist))
(if (= a 1)
(progn
(setq l(- kd kdn))
(setq point3(list(-(car point1)l)(cadr point1)(last point1)))
(setq ss(ssget "w" point1 point2))
(h_hlhz pjdn fx dist data1 data2 sm2)
(if smov
(progn
(command "_.move" smov "" point1 point3)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point1 point3)
(setq xlist(list(-(car point1)kd)(car point3)))
)
(progn
(setq point3(list(-(car point1)kd)(cadr point1)(last point1)))
(setq point4(list(+(car point3)kdn)(cadr point3)(last point3)))
(setq ss (ssget "w" point3 point2))
(h_hlhz pjdn fx dist data1 data2 sm2)
(if smov
(progn
(command "_.move" smov "" point3 point4)
(setq ss(C_ssgl ss smov))
)
)
(command "_.move" ss "" point3 point4)
(setq xlist(list(car point3)(car point4)))
)
)
xlist
)
;;=================================子函数开始=================================
;;名称：C_hlin
;;功能：画横线
;;输入：xlist-新订货图的x坐标表 ylist-所选订货图所有横线的Y坐标表 hlsm-回路数目
;;返回：无
(defun C_hlin(xlist ylist hlsm / point1 point2 i l n)
(setq i 0)
(setq l(/(abs(-(car xlist)(last xlist)))hlsm))
(repeat (length ylist)
(setq n 0)
(repeat hlsm
(setq point1(list(+(car xlist)(* l n))(nth i ylist)0.0))
(setq point2(list(+(car xlist)(* l (+ n 1)))(nth i ylist)0.0))
(command "_.line" point1 point2 "")
(setq n (+ n 1))
)
(setq i (+ i 1))
)
)
;;=================================子函数开始=================================
;;名称：s_px
;;功能：排序(从大到小)
;;输入：ylist-所选订货图所有横线的Y坐标表
;;返回：nylist
(defun s_px(ylist / i nylist yy list1 list2)
(setq nylist '())
(while (/= (length ylist) 0)
(setq i 1)
(setq yy (nth 0 ylist))
(repeat (-(length ylist)1)
(if (> yy (nth i ylist))
(setq yy (nth i ylist))
)
(setq i (+ i 1))
)
(setq nylist (cons yy nylist))
(setq list1 (cdr (member yy ylist)))
(setq list2 (cdr (member yy (reverse ylist))))
(setq ylist (append list1 list2))
)
nylist
)
;;=================================子函数开始=================================
;;名称：C_slin
;;功能：画竖线
;;输入：xzb-x坐标 ylist-所选订货图所有横线的Y坐标表
;;返回：无
(defun C_slin(xzb ylist / nylist point1 point2 i)
(setq i 0)
(setq nylist(s_px ylist))
(repeat (-(length nylist)1)
(setq point1(list xzb (nth i nylist)))
(setq point2(list xzb (nth (+ i 1) nylist)))
(command "_.line" point1 point2 "")
(setq i (+ i 1))
)
)
;;=================================子函数开始=================================
;;名称：h_comp
;;功能：计算两值的差(用于排序)
;;输入：a、b
;;返回：两值的差
(defun h_comp (a b)
(- a b)
)
;;=================================子函数开始=================================
;;名称: h_inwi
;;功能: 判断p1是否在p2 p3组成的窗口内
;;输入: p1 p2 p3
;;返回: 0-在窗口内、1-在窗口外、nil-边界上
(defun h_inwi (p1 p2 p3)
(cond
((and(< (car p1) (- (max (car p2) (car p3)) tscale))
(> (car p1) (+ (min (car p2) (car p3)) tscale))
(< (cadr p1) (- (max (cadr p2) (cadr p3)) tscale))
(> (cadr p1) (+ (min (cadr p2) (cadr p3)) tscale))
)
0
)
((or(> (car p1) (+ (max (car p2) (car p3)) tscale))
(< (car p1) (- (min (car p2) (car p3)) tscale))
(> (cadr p1) (+ (max (cadr p2) (cadr p3)) tscale))
(< (cadr p1) (- (min (cadr p2) (cadr p3)) tscale))
)
1
)
(t nil)
)
)
;;=================================子函数开始=================================
;;名称: h_mxwz
;;功能: 母线位置判断
;;输入: emx p1 p2
;;返回: mxwzt
(defun h_mxwz (emx p1 p2 / pd1 pd2 pc mxwzt)
(setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0)))
(if (or (> (car pc) (max (car p1) (car p2)))
(> (cadr pc) (max (cadr p1) (cadr p2)))
(< (car pc) (min (car p1) (car p2)))
(< (cadr pc) (min (cadr p1) (cadr p2)))
)
(setq mxwzt nil)
(setq mxwzt pc)
)
mxwzt
)
;;=================================子函数开始=================================
;;名称: h_wzpd
;;功能: 位置判断、判断实体（块-插入点，线-二端点）是否在窗口之内
;;输入: 实体名窗口二角点
;;返回: 在窗口内-中点
;; 不在窗口内-T
;; 交叉(线)-nil
(defun h_wzpd (emx p1 p2 ss / pd1 pd2 pc wzt npd1 npd2 es sins i)
(cond
((= (cdr (assoc 0 (entget emx))) "LWPOLYLINE")
(setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0)))
(setq npd1 (h_inwi pd1 p1 p2)
npd2 (h_inwi pd2 p1 p2)
)
(cond
((or(and (= npd1 0) (= npd2 1))(and (= npd2 0) (= npd1 1)))
(setq wzt nil)
)
((or (= npd1 1) (= npd2 1))
(setq wzt t)
)
(t (setq wzt pc))
)
)
(t
(setq pc (cdr (assoc 10 (entget emx))))
(cond
((= (h_inwi pc p1 p2) 1)
(setq wzt t)
)
((null (h_inwi pc p1 p2))
(if (= (cdr (assoc 0 (entget emx))) "insert")
(progn
(setq sins (ssget "c"
(polar pc (* 0.25 pi) tscale)
(polar pc (* 0.25 pi) tscale)
'((0 . "insert,lwpolyline"))
)
)
(setq wzt pc
i 0
)
(while (and wzt (< i (sslength sins)))
(setq es (ssname sins i))
(if (not (ssmemb es sins))
(setq wzt t)
(setq i (1+ i))
)
)
)
(setq wzt pc)
)
)
(t (setq wzt pc))
)
)
)
wzt
)
;;=================================子函数开始=================================
;;名称: h_wzyz
;;功能: 母线位置一致性判断
;;输入: 母线循环号 (方向初值坐标初值)
;;返回: i=0 (方向坐标)
;; i/=0 位置一致 t
;; 位置不一致 nil
(defun h_wzyz (emx i first / fxhsf hszf pmxd1 pmxd2 fxhs hsz wzyz)
(setq fxhsf (car first)
hszf (cadr first)
)
(setq pmxd1 (append (cdr (assoc 10 (entget emx))) (list 0.0))
pmxd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0))
)
(if(equal (car pmxd1) (car pmxd2) 0.001)
(setq fxhs 1 hsz (car pmxd1))
(setq fxhs 0 hsz (cadr pmxd1))
)
(if(= i 0)
(setq wzyz (list fxhs hsz))
(progn
(if (or(not (equal fxhs fxhsf 0.01))
(not (equal hsz hszf 0.01))
)
(setq wzyz nil)
(setq wzyz t)
)
)
)
wzyz
)
;;=================================子函数开始=================================
;;名称: h_xzhl
;;功能: 选择回路
;;输入: 窗口二角点p1，p2
;;返回: t-(基点方向? 宽度回路选择集回路数) 方向--0 向下 1 向右 2 向上 3 向左
;; NIL-nil
(defun h_xzhl (p1 p2 / ssfah fah pjd fx sshl hlsm
kd hll smx i mxt fxhs hsz len1 ii
emx iii pd1 pd2 mxmin mxmax p1 p2 pc
ss i4 pcl first e pcxl pcyl pcc xzt
len2
)
(setq hll nil)
(setq smx (ssget "c" p1 p2 '((0 . "lwpolyline") (8 . "mx"))))
(if smx
(progn
(setq i 0 mxt t)
(while (and mxt (< i (sslength smx)))
(setq emx (ssname smx i))
(if (= i 0)
(setq first (h_wzyz emx 0 nil))
(setq mxt (h_wzyz emx i first))
)
(setq i (1+ i))
) ;判断母线位置一致性
(if mxt
(progn
(setq fxhs (car first)
hsz (cadr first)
ii 0
len1 (sslength smx)
)
(repeat len1
(setq emx (ssname smx ii))
(if (h_mxwz emx p1 p2)
(setq ii (1+ ii))
(ssdel emx smx)
)
) ;删除中心在边界外的母线
(setq hlsm (sslength smx))
(if (/= hlsm 0)
(progn
(setq iii 0)
(repeat hlsm
(setq emx (ssname smx iii))
(setq pd1 (cdr (assoc 10 (entget emx)))
pd2 (cdr (assoc 10 (reverse (entget emx))))
)
(if (= fxhs 0)
(if (= iii 0)
(setq mxmin (min (car pd1) (car pd2))
mxmax (max (car pd1) (car pd2))
)
(progn
(if (< (min (car pd1) (car pd2)) mxmin)
(setq mxmin (min (car pd1) (car pd2)))
)
(if (> (max (car pd1) (car pd2)) mxmax)
(setq mxmax (max (car pd1) (car pd2)))
)
)
)
(if (= iii 0)
(setq mxmin (min (cadr pd1) (cadr pd2))
mxmax (max (cadr pd1) (cadr pd2))
)
(progn
(if (< (min (cadr pd1) (cadr pd2)) mxmin)
(setq mxmin (min (cadr pd1) (cadr pd2)))
)
(if (> (max (cadr pd1) (cadr pd2)) mxmax)
(setq mxmax (max (cadr pd1) (cadr pd2)))
)
)
)
)
(setq iii (1+ iii))
)
(setq kd (- mxmax mxmin))
(if (= fxhs 0)
(setq p1 (list mxmin (cadr p1) 0.0)
p2 (list mxmax (cadr p2) 0.0)
pjd (list (/ (+ mxmin mxmax) 2) hsz 0.0)
)
(setq p1 (list (car p1) mxmin 0.0)
p2 (list (car p2) mxmax 0.0)
pjd (list hsz (/ (+ mxmin mxmax) 2) 0.0)
)
) ;取得母线范围并更新选择集窗口
(setq ss (ssget "c" p1 p2 '((8 . "mx,fah,bxt,xhgg,xmdh"))))
(setq i4 0
pcl nil
len2 (sslength ss)
xzt t
)
(while (and xzt (< i4 len2))
(setq e (ssname ss i4))
(if (setq pc (h_wzpd e p1 p2 smx))
(progn
(if (= pc t)
(progn
(ssdel e ss)
(setq len2 (1- len2))
)
(progn
(setq pcl (cons pc pcl))
(setq i4 (1+ i4))
)
)
)
(setq xzt nil)
)
)
;去掉多余实体,如果交叉结束
(if xzt
(progn
(setq pcxl (mapcar 'car pcl)
pcyl (mapcar 'cadr pcl)
)
(setq pcc (list (/ (apply '+ pcxl) (length pcl))
(/ (apply '+ pcyl) (length pcl))
0.0
)
)
(if (= fxhs 0)
(if (< (cadr pcc) (cadr pjd))
(setq fx 0)
(setq fx 2)
)
(if (> (car pcc) (car pjd))
(setq fx 1)
(setq fx 3)
)
)
(setq hll (list pjd fx kd ss hlsm))
)
(Xacino "回路选择不完整!" "操作错误" 6)
)
)
)
)
(Xacino "选了其他回路的母线!" "操作错误" 6)
)
)
)
hll
)
;;=================================子函数开始=================================
;;名称: h_lxdd
;;功能: 连续母线端点
;;输入: 端点方向
;;返回: 下一端点
(defun h_lxdd (pds fx hljj / p1 p2 lxl pde e hs smxal)
(setq pde nil)
(setq smxal (ssget "x" '((8 . "mx"))))
(if(or (= fx 0) (= fx 2))
(setq lxl (list (car pds)))
(setq lxl (list (cadr pds)))
)
(while (setq e (ssname smxal 0))
(setq p1 (cdr (assoc 10 (entget e)))
p2 (cdr (assoc 10 (reverse (entget e))))
)
(if (or (= fx 0) (= fx 2))
(if (and (equal (cadr p1) (cadr pds) 0.001)
(equal (cadr p2) (cadr pds) 0.001)
)
(if (> (setq hs (max (car p1) (car p2))) (car pds))
(setq lxl (cons hs lxl))
)
)
(if (and (equal (car p1) (car pds) 0.001)
(equal (car p2) (car pds) 0.001)
)
(if (> (setq hs (max (cadr p1) (cadr p2))) (cadr pds))
(setq lxl (cons hs lxl))
)
)
)
(ssdel e smxal)
)
(if(> (length lxl) 1)
(setq lxl (qsort h_comp lxl))
)
(while (and (> (length lxl) 1)
(< (- (cadr lxl) (car lxl)) (* 1.5 hljj))
)
(setq lxl (cdr lxl))
(if (or (= fx 0) (= fx 2))
(setq pde (list(car lxl)(cadr pds) 0.0))
(setq pde (list(car pds)(car lxl) 0.0))
)
)
pde
)
;;=================================子函数开始=================================
;;名称: h_lxxz
;;功能: 连续回路选择,选择由一点开始的所有连续同方向回路
;;输入: 开始点结束点方向
;;返回: 选择集
(defun h_lxxz (pds pde fx / p1 p2 ss i ls emx dqw1 wzpdt)
(setq ss nil)
(if (and pds pde)
(progn
(cond
((= fx 0)
(setq p1 (polar pds (* 1.5 pi) (* 90 tscale))
p2 (polar pde (* 0.5 pi) (* 2 tscale))
)
)
((= fx 1)
(setq p1 (polar pds pi (* 2 tscale))
p2 (polar pde 0 (* 90 tscale))
)
)
((= fx 2)
(setq p1 (polar pds (* 1.5 pi) (* 2 tscale))
p2 (polar pde (* 0.5 pi) (* 90 tscale))
)
)
((= fx 3)
(setq p1 (polar pds pi (* 90 tscale))
p2 (polar pde 0 (* 2 tscale))
)
)
)
(setq dqw1 (XScjx))
(if (or (= (h_inwi p1 (car dqw1) (cadr dqw1)) 1)
(= (h_inwi p2 (car dqw1) (cadr dqw1)) 1)
)
(progn
(command "_.zoom"
(list (min (car p1) (caar dqw1))
(min (cadr p1) (cadar dqw1))
)
(list (max (car p2) (caadr dqw1))
(max (cadr p2) (cadadr dqw1))
)
)
)
)
(setq ss (ssget "c" p1 p2 '((8 . "mx,bxt,fah,xhgg,xmdh"))))
(setq i 0
ls (sslength ss)
)
(repeat ls
(setq emx (ssname ss i))
(setq wzpdt (h_wzpd emx p1 p2 ss))
(if (or (null wzpdt) (= wzpdt t))
(ssdel emx ss)
(setq i (1+ i))
)
)
)
)
ss
)
;;=================================子函数开始=================================
;;名称: h_hlhz
;;功能: 回路绘制
;;输入: 回路起始点方向回路间距
;;返回: 无
(defun h_hlhz(pjd fx dist data1 data2 sm2 / zdist pds pdmx2 pdmx1 mxkd shu)
(setq zdist (* sm2 dist))
(Xsetin "Hlklib" "Hlkjj" (rtos (/ dist tscale) 2 2) 1)
(shldy pjd fx data1 data2) ;回路绘制
(command "_.color" "_green")
(command "_.Layer" "_m" "mx" "_c" 3 "" "")
(if (or (= fx 0) (= fx 2))
(setq pds (polar pjd 0 (* -0.5 zdist)))
(setq pds (polar pjd (* 0.5 pi) (* -0.5 zdist)))
)
(setq pdmx1 pds)
(repeat sm2
(if (or (= fx 0) (= fx 2))
(setq pdmx2 (polar pdmx1 0 dist))
(setq pdmx2 (polar pdmx1 (* 0.5 pi) dist))
)
(setq mxkd (atof (Xgetin "Hlklib" "Hlkmx" "0.6" 1)))
(setq mxkd (* mxkd tscale))
(command "_.pline" pdmx1 "_w" mxkd "" pdmx2 "")
(setq pdmx1 pdmx2)
) ;母线绘制
(setq shu(tblsearch "layer""GDXT"))
(if shu(command "_.layer" "_set" "GDXT" ""))
)
;;=================================子函数开始=================================
;;名称: h_sh4
;;功能: 回路删除
;;输入: 无
;;返回: 无
(defun h_sh4 (/ lll1 ph1 ph2 ttt1 hlxzl pjd fx kd sshl hlsm pmde jj dist pmds
sm2 smov zxj ysj mylist plist pmdsn ss1 ss2 ylist xlist fan s4_xc
s4_glx shu)
;;=================================子函数开始=================================
;;名称: s4_glx
;;功能: 过滤x坐标一定的所有竖线
;;输入: ss-选择集 xlist-x坐标 mylist-定货图的两个角点
;;返回: ss
(defun s4_glx(ss xlist mylist / point1 point2 point3 point4 ss1 ss2)
(setq point1(list (car xlist)(cadr(car mylist))))
(setq point2(list (car xlist)(cadr(cadr mylist))))
(setq point3(list (last xlist)(cadr(car mylist))))
(setq point4(list (last xlist)(cadr(cadr mylist))))
(setq ss1(ssget "W" point1 point2 '((0 . "LINE")(8 . "GDXT"))))
(setq ss2(ssget "W" point3 point4 '((0 . "LINE")(8 . "GDXT"))))
(if ss1 (setq ss(C_ssgl ss ss1)))
(if ss2 (setq ss(C_ssgl ss ss2)))
ss
)
;;=================================子函数开始=================================
;;名称: s4_xc
;;功能: 消重直线
;;输入: xlist-x坐标 mylist-定货图的两个角点 ylist-y坐标表
;;返回: 无
(defun s4_xc(xlist mylist ylist pjd / point point1 point2 point3 point4 ss1 ss2)
(setq point(list(last xlist)(cadr pjd)(last pjd)))
(setq point1(list(last xlist)(cadr(cadr mylist))))
(setq point2(list(last xlist)(cadr(car mylist))))
(setq point3(list(-(car point)10)(+(cadr point)10)))
(setq point4(list(+(car point)10)(-(cadr point)10)))
(setq ss1(ssget "W" point1 point2 '((0 . "LINE")(8 . "GDXT"))))
(setq ss2(ssget "C" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3))))
(if ss2(progn(C_slin (last xlist) ylist)(command "_.erase" ss1 "")))
)
;;h_sh4主函数开始
(setq zxj(car(XScjx)))
(setq ysj(last(XScjx)))
(setq lll1 t)
(while lll1
(command "_.undo" "_group")
(setq shu(tblsearch "layer""GDXT"))
(if shu(command "_.layer" "_set" "GDXT" ""))
(setq fan 1)
(prompt "\n请用窗口(W)选择删除回路:")
(setq ph1 1)
(while(not(listp ph1))
(initget 128)
(setq ph1 (getpoint "\n请输入窗口第一点<回车结束>:"))
)
(if ph1
(progn
(setq ttt1 t)
(while ttt1
(setq ph2 1)
(while(not(listp ph2))
(initget 128)
(setq ph2 (getcorner ph1 "\n请输入窗口第二点:"))
)
(if ph2
(progn
(setq hlxzl(h_xzhl ph1 ph2))
(if hlxzl
(progn
(setq ttt1 nil)
(setq pjd (nth 0 hlxzl)
fx (nth 1 hlxzl)
kd (nth 2 hlxzl)
sshl (nth 3 hlxzl)
hlsm (nth 4 hlxzl)
)
(setq jj(/ kd hlsm))
(if(or(= fx 0)(= fx 2))
(setq pmds(polar pjd 0(/ kd 2.0)) pmdsn(polar pjd 0(/ kd -2.0)))
(setq pmds(polar pjd(* 0.5 pi)(/ kd 2.0))
pmdsn (polar pjd(* 0.5 pi)(/ kd -2.0))
)
)
(setq pmde (h_lxdd pmds fx jj))
(setq smov (h_lxxz pmds pmde fx))
(setq mylist(dhtss pmds 2))
(if(and(or(= fx 0)(= fx 2))mylist)
(progn
(C_zoom mylist zxj ysj)
(setq ylist (C_xyzb mylist pjd kd))
(setq plist (C_ldel mylist pjd kd sshl))
(setq ss1 (ssget "w" (car plist)(cadr plist)))
(setq ss2 (last plist))
(setq xlist(list(car pmds)(car pmdsn)))
(setq ss2 (s4_glx ss2 xlist mylist))
(command "_.erase" sshl "")
(command "_.erase" ss2 "")
(if smov
(progn
(command "_.move" smov "" pmds pmdsn)
(setq ss1 (C_ssgl ss1 smov))
)
)
(command "_.move" ss1 "" pmds pmdsn)
(s4_xc xlist mylist ylist pjd)
(Command "_.zoom" zxj ysj)
)
(progn
(if smov (command "_.move" smov "" pmds pmdsn))
(command "_.erase" sshl "")
)
)
)
(setq ttt1 nil)
)
)
)
)
)
(setq lll1 nil)
)
(command "_.undo" "_end")
(setq fan 0)
)
)
;;================================子函数结束==================================
(_inidwg)
(princ "\n*回路删除*=Hldel")
(setvar "plinetype" 2)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "pickadd" 1)
(setvar "osmode" 0)
(setvar "CECOLOR" "green")
(setq ucmark (getvar "worlducs"))
(if (= ucmark 0)
(progn
(setq ucs_fo (getvar "ucsfollow"))
(if (= ucs_fo 1)(setvar "ucsfollow" 0))
(command "_.ucs" "_world")
)
)
(setq lxfs 0 tscale(atof(xrddic "Tabscale" "100")) dqw(XScjx))
(setq o_para(xgetin "Hlklib" "Hlkpara" "" 1)
o_mes(xgetin "Hlklib" "RetHlkMes" "" 1)
o_jj(xgetin "Hlklib" "Hlkjj" "30" 1)
)
(menucmd "s=hd25l")
(h_sh4)
(if(= ucmark 0)(command "_.ucs" "_prev"))
(setvar "highlight" 1)
(setq dqwn(XScjx))
(if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw)))
(setq *error* olderr olderr nil)
(_resdwg)
(princ)
)

;;=================================主程序开始================================= 
;;名称：C:HLTH 
;;功能：回路替换 
;;输入：无 
;;返回：无 
(defun C:HLTH(/ tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo 
                h_sh1 h_XZHL h_WZYZ h_HLHZ h_LXDD h_WZPD h_LXXZ h_mxwz h_inwi 
                h_comp C_zoom C_ssgl C_xyzb C_ldel C_movt C_movk C_hlin C_slin 
                s_px) 
  (setq olderr *error*) 
   
;;=================================子函数开始================================= 
;;名称：*error*(错误处理函数) 
;;功能：当程序发生错误或用户中断时，平静地退出，并还原状态。 
;;输入：无 
;;返回：无 
(defun *error* (msg / each) 
  (if (= fan 1)(command "_.undo" "_end")) 
  (if (= fan 1)(command "_.undo" "")) 
  (if (= ucmark 0) (command "_.ucs" "_prev")) 
  (xsetin "Hlklib" "Hlkpara" o_para 1) 
  (xsetin "Hlklib" "RetHlkMes" o_mes 1) 
  (xsetin "Hlklib" "Hlkjj" o_jj 1) 
  (if(= lxfs 1) 
    (progn(setq i 0)(repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i)))) 
  ) 
  (setq dqwn (XScjx)) 
  (if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw))) 
  (foreach each 
      '(tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo h_sh1 h_xzhl 
        h_wzyz h_hlhz h_lxdd h_wzpd h_lxxz h_mxwz h_inwi h_comp C_zoom C_ssgl C_xyzb 
        C_ldel C_movt C_movk C_hlin C_slin point1 point2 i ename point3 point4 ss 
        elist point5 point6 biao ylist plist l xlist n nylist s_px yy list1 list2 a b 
        emx p1 p2 p3 pd1 pd2 pc mxwzt wzt npd1 npd2 es sins first fxhsf hszf pmxd1 
        pmxd2 fxhs hsz wzyz ssfah fah pjd fx sshl hlsm kd hll smx mxt len1 ii iii mxmin 
        mxmax i4 pcl e pcxl pcyl pcc xzt len2 pds hljj lxl pde hs smxal ls dqw1 wzpdt 
        dist data1 data2 sm2 zdist pdmx2 mxkd lll1 ph1 ph2 ttt1 hlxzl lll2 ttt2 ph3 ph4 
        slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj jjn hldata smov zxj 
        ysj zxjn ysjn mylist ess fan name laye yanse hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 pjd2 
        fx2 kd2 hlsm2 hlxzl2 pjdn1 pjd1n pjd2n pme smov1 smov2 pmds1 pmds1n pmds2 pmds2n 
        pmde1 pmde2 jj1 jj2 sshl2 ss1 ss2 ss3 ylist1 ylist2 plist1 plist2 xlist1 xlist2 
        ess1 ess2 point shu xzb) 
      (set each nil) 
    ) 
    (setq each nil) 
    (setq *error* olderr olderr nil) 
    (_resdwg) 
    (princ) 
) 
 
;;=================================子函数开始================================= 
;;名称：C_zoom 
;;功能：判断是否zoom 
;;输入：mylist-订货图的角表 zxj-视区左下角 ysj-视区右上角 
;;返回：无 
(defun C_zoom(mylist zxjn ysjn / point1 point2) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (if(or(>(car zxjn)(car point2))(<(car ysjn)(car point1)) 
        (>(cadr zxjn)(cadr point1))(<(cadr ysjn)(cadr point2)) 
     ) 
    (command "_.ZOOM" "_w" point1 point2) 
  ) 
) 
 
;;=================================子函数开始================================= 
;;名称：C_ssgl 
;;功能：过滤选择集 
;;输入：ss1-选择集1 ss2-选择集2 
;;返回：ss1 
 (defun C_ssgl(ss1 ss2 / i ename) 
  (setq i 0) 
  (repeat(sslength ss2) 
    (setq ename (ssname ss2 i)) 
    (ssdel ename ss1) 
    (setq i (+ i 1)) 
  ) 
  ss1 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_xyzb 
;;功能：得到所选回路所有横线的Y坐标点集 
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 
;;返回：ylist-所选回路所有横线的Y坐标表 
 (defun C_xyzb(mylist pjd kd / point1 point2 point3 point4 i ss ename elist 
                                   point5 point6 biao ylist) 
  (setq ylist '()) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2))) 
  (setq point4(list(+(car point3)kd)(cadr point1)(last point1))) 
  (setq ss (ssget "W" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3)))) 
  (setq i 0) 
  (repeat (sslength ss) 
    (setq ename (ssname ss i)) 
    (setq elist (entget ename)) 
    (setq point5(cdr(assoc 10 elist))) 
    (setq point6(cdr(assoc 11 elist))) 
    (if (equal(cadr point5)(cadr point6)0.1) 
      (progn 
        (setq biao(member (cadr point5) ylist)) 
        (if (not biao) 
          (setq ylist(cons (cadr point5) ylist)) 
        ) 
      ) 
    ) 
    (setq i (+ i 1)) 
  ) 
  ylist 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_ldel 
;;功能：得到所选回路列的左上角和右下角 
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 sshl-回路选择集 
;;返回：plist-点表(所选回路列的右上角、订货图的右下角和所选回路列的选择集) 
 (defun C_ldel(mylist pjd kd sshl / point1 point2 point3 point4 point5 ss plist) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2))) 
  (setq point4(list(+(car pjd)(/ kd 2))(cadr point1)(last point2))) 
  (setq ss(ssget "w" point3 point4)) 
  (setq ss(C_ssgl ss sshl)) 
  (setq point5(list(car point4)(cadr point2)(last point2))) 
  (setq plist (list point5 point1 ss)) 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_movt 
;;功能：copy回路并移动表格(从当前图中copy或move) 
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度 
;;      sshln-替换回路 pjdf-替换回路的基点 pjd-被替回路的基点 smov-回路选择集 
;;      a-为0时拷贝,为1时移动,为2时插入 
;;返回：xlist-新回路列的x坐标 
(defun C_movt(plist kd kdn sshln pjdf pjdn smov a / point1 point2 l point3 point4 xlist ss) 
  (setq point1(car plist)) 
  (setq point2(cadr plist)) 
  (if(or(= a 0)(= a 1)) 
    (progn 
      (setq l(- kd kdn)) 
      (setq point3(list(-(car point1)l)(cadr point1)(last point1))) 
      (setq ss(ssget "w" point1 point2)) 
      (if (= a 0) 
        (command "_.copy" sshln "" pjdf pjdn) 
        (command "_.move" sshln "" pjdf pjdn) 
      ) 
      (if smov 
        (progn 
          (command "_.move" smov "" point1 point3) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point1 point3) 
      (setq xlist(list(-(car point1)kd)(car point3))) 
    ) 
    (progn 
      (setq point3(list(-(car point1)kd)(cadr point1)(last point1))) 
      (setq point4(list(+(car point3)kdn)(cadr point3)(last point3))) 
      (setq ss (ssget "w" point3 point2)) 
      (command "_.copy" sshln "" pjdf pjdn) 
      (if smov 
        (progn 
          (command "_.move" smov "" point3 point4) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point3 point4) 
      (setq xlist(list(car point3)(car point4))) 
    ) 
  ) 
  xlist 
) 
 
;;=================================子函数开始================================= 
;;名称：C_movk 
;;功能：copy回路并移动表格(从图库中取) 
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度 
;;      pjdn-替换回路 fx-回路方向 dist、data1、data2、sm2-调回路库的参数 smov-回路选择集 
;;      a-为时替换回路,为2时插入回路 
;;返回：xlist-新回路列的两个x坐标 
(defun C_movk(plist kd kdn pjdn fx dist data1 data2 sm2 smov a / point1 point2 l point3 
              point4 xlist ss) 
  (setq point1(car plist)) 
  (setq point2(cadr plist)) 
  (if (= a 1) 
    (progn 
      (setq l(- kd kdn)) 
      (setq point3(list(-(car point1)l)(cadr point1)(last point1))) 
      (setq ss(ssget "w" point1 point2)) 
      (h_hlhz pjdn fx dist data1 data2 sm2) 
      (if smov 
        (progn 
          (command "_.move" smov "" point1 point3) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point1 point3) 
      (setq xlist(list(-(car point1)kd)(car point3))) 
    ) 
    (progn 
      (setq point3(list(-(car point1)kd)(cadr point1)(last point1))) 
      (setq point4(list(+(car point3)kdn)(cadr point3)(last point3))) 
      (setq ss (ssget "w" point3 point2)) 
      (h_hlhz pjdn fx dist data1 data2 sm2) 
      (if smov 
        (progn 
          (command "_.move" smov "" point3 point4) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point3 point4) 
      (setq xlist(list(car point3)(car point4))) 
    ) 
  ) 
  xlist 
) 
 
;;=================================子函数开始================================= 
;;名称：C_hlin 
;;功能：画横线 
;;输入：xlist-新订货图的x坐标表 ylist-所选订货图所有横线的Y坐标表 hlsm-回路数目 
;;返回：无 
(defun C_hlin(xlist ylist hlsm / point1 point2 i l n) 
  (setq i 0) 
  (setq l(/(abs(-(car xlist)(last xlist)))hlsm)) 
  (repeat (length ylist) 
    (setq n 0) 
    (repeat hlsm 
      (setq point1(list(+(car xlist)(* l n))(nth i ylist)0.0)) 
      (setq point2(list(+(car xlist)(* l (+ n 1)))(nth i ylist)0.0)) 
      (command "_.line" point1 point2 "") 
      (setq n (+ n 1)) 
    ) 
    (setq i (+ i 1)) 
  ) 
) 
 
;;=================================子函数开始================================= 
;;名称：s_px 
;;功能：排序(从大到小) 
;;输入：ylist-所选订货图所有横线的Y坐标表 
;;返回：nylist 
  (defun s_px(ylist / i nylist yy list1 list2) 
    (setq nylist '()) 
    (while (/= (length ylist) 0) 
      (setq i 1) 
      (setq yy (nth 0 ylist)) 
      (repeat (-(length ylist)1) 
        (if (> yy (nth i ylist)) 
          (setq yy (nth i ylist)) 
        ) 
        (setq i (+ i 1)) 
      ) 
      (setq nylist (cons yy nylist)) 
      (setq list1 (cdr (member yy ylist))) 
      (setq list2 (cdr (member yy (reverse ylist)))) 
      (setq ylist (append list1 list2)) 
    ) 
    nylist 
  ) 
 
;;=================================子函数开始================================= 
;;名称：C_slin 
;;功能：画竖线 
;;输入：xzb-x坐标 ylist-所选订货图所有横线的Y坐标表 
;;返回：无 
 (defun C_slin(xzb ylist / nylist point1 point2 i) 
  (setq i 0) 
  (setq nylist(s_px ylist)) 
  (repeat (-(length nylist)1) 
    (setq point1(list xzb (nth i nylist))) 
    (setq point2(list xzb (nth (+ i 1) nylist))) 
    (command "_.line" point1 point2 "") 
    (setq i (+ i 1)) 
  ) 
 ) 
   
;;=================================子函数开始================================= 
;;名称：h_comp 
;;功能：计算两值的差(用于排序) 
;;输入：a、b 
;;返回：两值的差 
  (defun h_comp (a b) 
    (- a b) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_inwi 
;;功能: 判断p1是否在p2 p3组成的窗口内 
;;输入: p1 p2 p3 
;;返回: 0-在窗口内、1-在窗口外、nil-边界上 
  (defun h_inwi (p1 p2 p3) 
    (cond 
      ((and(< (car p1) (- (max (car p2) (car p3)) tscale)) 
            (> (car p1) (+ (min (car p2) (car p3)) tscale)) 
            (< (cadr p1) (- (max (cadr p2) (cadr p3)) tscale)) 
            (> (cadr p1) (+ (min (cadr p2) (cadr p3)) tscale)) 
        ) 
        0 
      ) 
      ((or(> (car p1) (+ (max (car p2) (car p3)) tscale)) 
           (< (car p1) (- (min (car p2) (car p3)) tscale)) 
           (> (cadr p1) (+ (max (cadr p2) (cadr p3)) tscale)) 
           (< (cadr p1) (- (min (cadr p2) (cadr p3)) tscale)) 
        ) 
        1 
      ) 
      (t nil) 
    ) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_mxwz 
;;功能: 母线位置判断 
;;输入: emx p1 p2 
;;返回: mxwzt 
  (defun h_mxwz        (emx p1 p2 / pd1 pd2 pc mxwzt) 
    (setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
          pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
    ) 
    (setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0))) 
    (if        (or (> (car pc) (max (car p1) (car p2))) 
            (> (cadr pc) (max (cadr p1) (cadr p2))) 
            (< (car pc) (min (car p1) (car p2))) 
            (< (cadr pc) (min (cadr p1) (cadr p2))) 
        ) 
      (setq mxwzt nil) 
      (setq mxwzt pc) 
    ) 
    mxwzt 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_wzpd 
;;功能: 位置判断、判断实体（块-插入点，线-二端点）是否在窗口之内 
;;输入: 实体名 窗口二角点 
;;返回: 在窗口内-中点 
;;      不在窗口内-T 
;;      交叉(线)-nil 
  (defun h_wzpd (emx p1 p2 ss / pd1 pd2 pc wzt npd1 npd2 es sins i) 
    (cond 
      ((= (cdr (assoc 0 (entget emx))) "LWPOLYLINE") 
       (setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
             pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
       ) 
       (setq pc        (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0))) 
       (setq npd1 (h_inwi pd1 p1 p2) 
             npd2 (h_inwi pd2 p1 p2) 
       ) 
       (cond 
        ((or(and (= npd1 0) (= npd2 1))(and (= npd2 0) (= npd1 1))) 
         (setq wzt nil) 
        ) 
         ((or (= npd1 1) (= npd2 1)) 
          (setq wzt t) 
         ) 
         (t (setq wzt pc)) 
       ) 
      ) 
      (t 
       (setq pc (cdr (assoc 10 (entget emx)))) 
       (cond 
        ((= (h_inwi pc p1 p2) 1) 
          (setq wzt t) 
         ) 
         ((null (h_inwi pc p1 p2)) 
          (if (= (cdr (assoc 0 (entget emx))) "insert") 
            (progn 
              (setq        sins (ssget "c" 
                                    (polar pc (* 0.25 pi) tscale) 
                                    (polar pc (* 0.25 pi) tscale) 
                                    '((0 . "insert,lwpolyline")) 
                             ) 
                  ) 
                  (setq        wzt pc 
                        i   0 
                  ) 
                  (while (and wzt (
                    (setq es (ssname sins i)) 
                    (if        (not (ssmemb es sins)) 
                      (setq wzt t) 
                      (setq i (1+ i)) 
                    ) 
                  ) 
                ) 
                (setq wzt pc) 
              ) 
             ) 
             (t (setq wzt pc)) 
       ) 
      ) 
    ) 
    wzt 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_wzyz 
;;功能: 母线位置一致性判断 
;;输入: 母线 循环号 (方向初值 坐标初值) 
;;返回: i=0 (方向 坐标) 
;;      i/=0 位置一致 t 
;;           位置不一致 nil 
  (defun h_wzyz        (emx i first / fxhsf hszf pmxd1 pmxd2 fxhs hsz wzyz) 
    (setq fxhsf        (car first) 
          hszf        (cadr first) 
    ) 
    (setq pmxd1        (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
          pmxd2        (append        (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
    ) 
    (if(equal (car pmxd1) (car pmxd2) 0.001) 
      (setq fxhs 1 hsz (car pmxd1)) 
      (setq fxhs 0 hsz (cadr pmxd1)) 
    ) 
    (if(= i 0) 
      (setq wzyz (list fxhs hsz)) 
      (progn 
        (if (or(not (equal fxhs fxhsf 0.01)) 
                (not (equal hsz hszf 0.01)) 
            ) 
         (setq wzyz nil) 
          (setq wzyz t) 
        ) 
      ) 
    ) 
    wzyz 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_xzhl 
;;功能: 选择回路 
;;输入: 窗口二角点p1，p2 
;;返回: t-(基点 方向? 宽度 回路选择集 回路数) 方向--0 向下 1 向右 2 向上 3 向左 
;;       NIL-nil 
  (defun h_xzhl        (p1    p2    /           ssfah fah   pjd   fx           sshl         hlsm 
                 kd    hll   smx   i         mxt   fxhs  hsz   len1         ii 
                 emx   iii   pd1   pd2         mxmin mxmax p1           p2         pc 
                 ss    i4    pcl   first e     pcxl  pcyl  pcc   xzt 
                 len2 
                ) 
    (setq hll nil) 
    (setq smx (ssget "c" p1 p2 '((0 . "lwpolyline") (8 . "mx")))) 
    (if        smx 
      (progn 
        (setq i        0 mxt t) 
        (while (and mxt (
          (setq emx (ssname smx i)) 
          (if (= i 0) 
            (setq first (h_wzyz emx 0 nil)) 
            (setq mxt (h_wzyz emx i first)) 
          ) 
          (setq i (1+ i)) 
        )                                ;判断母线位置一致性 
        (if mxt 
          (progn 
            (setq fxhs (car first) 
                  hsz  (cadr first) 
                  ii   0 
                  len1 (sslength smx) 
            ) 
            (repeat len1 
              (setq emx (ssname smx ii)) 
              (if (h_mxwz emx p1 p2) 
                (setq ii (1+ ii)) 
                (ssdel emx smx) 
              ) 
            )                                ;删除中心在边界外的母线 
            (setq hlsm (sslength smx)) 
            (if        (/= hlsm 0) 
              (progn 
                (setq iii 0) 
                (repeat        hlsm 
                  (setq emx (ssname smx iii)) 
                  (setq        pd1 (cdr (assoc 10 (entget emx))) 
                        pd2 (cdr (assoc 10 (reverse (entget emx)))) 
                  ) 
                  (if (= fxhs 0) 
                    (if        (= iii 0) 
                      (setq mxmin (min (car pd1) (car pd2)) 
                            mxmax (max (car pd1) (car pd2)) 
                      ) 
                      (progn 
                        (if (< (min (car pd1) (car pd2)) mxmin) 
                          (setq mxmin (min (car pd1) (car pd2))) 
                        ) 
                        (if (> (max (car pd1) (car pd2)) mxmax) 
                          (setq mxmax (max (car pd1) (car pd2))) 
                        ) 
                      ) 
                    ) 
                    (if        (= iii 0) 
                      (setq mxmin (min (cadr pd1) (cadr pd2)) 
                            mxmax (max (cadr pd1) (cadr pd2)) 
                      ) 
                      (progn 
                        (if (< (min (cadr pd1) (cadr pd2)) mxmin) 
                          (setq mxmin (min (cadr pd1) (cadr pd2))) 
                        ) 
                        (if (> (max (cadr pd1) (cadr pd2)) mxmax) 
                          (setq mxmax (max (cadr pd1) (cadr pd2))) 
                        ) 
                      ) 
                    ) 
                  ) 
                  (setq iii (1+ iii)) 
                ) 
                (setq kd (- mxmax mxmin)) 
                (if (= fxhs 0) 
                  (setq        p1  (list mxmin (cadr p1) 0.0) 
                        p2  (list mxmax (cadr p2) 0.0) 
                        pjd (list (/ (+ mxmin mxmax) 2) hsz 0.0) 
                  ) 
                  (setq        p1  (list (car p1) mxmin 0.0) 
                        p2  (list (car p2) mxmax 0.0) 
                        pjd (list hsz (/ (+ mxmin mxmax) 2) 0.0) 
                  ) 
                )                        ;取得母线范围并更新选择集窗口 
 
                (setq ss (ssget "c" p1 p2 '((8 . "mx,fah,bxt,xhgg,xmdh")))) 
                (setq i4   0 
                      pcl  nil 
                      len2 (sslength ss) 
                      xzt  t 
                ) 
                (while (and xzt (< i4 len2)) 
                  (setq e (ssname ss i4)) 
                  (if (setq pc (h_wzpd e p1 p2 smx)) 
                    (progn 
                      (if (= pc t) 
                        (progn 
                          (ssdel e ss) 
                          (setq len2 (1- len2)) 
                        ) 
                        (progn 
                          (setq pcl (cons pc pcl)) 
                          (setq i4 (1+ i4)) 
                        ) 
                      ) 
                    ) 
                    (setq xzt nil) 
                  ) 
                ) 
                                        ;去掉多余实体,如果交叉结束 
                (if xzt 
                  (progn 
                    (setq pcxl (mapcar 'car pcl) 
                          pcyl (mapcar 'cadr pcl) 
                    ) 
                    (setq pcc (list (/ (apply '+ pcxl) (length pcl)) 
                                    (/ (apply '+ pcyl) (length pcl)) 
                                    0.0 
                              ) 
                    ) 
                    (if        (= fxhs 0) 
                      (if (< (cadr pcc) (cadr pjd)) 
                        (setq fx 0) 
                        (setq fx 2) 
                      ) 
                      (if (> (car pcc) (car pjd)) 
                        (setq fx 1) 
                        (setq fx 3) 
                      ) 
                    ) 
                    (setq hll (list pjd fx kd ss hlsm)) 
                  ) 
                  (Xacino "回路选择不完整!" "操作错误" 6) 
                ) 
              ) 
            ) 
          ) 
          (Xacino "选了其他回路的母线!" "操作错误" 6) 
        ) 
      ) 
    ) 
    hll 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_lxdd 
;;功能: 连续母线端点 
;;输入: 端点 方向 
;;返回: 下一端点 
  (defun h_lxdd        (pds fx hljj / p1 p2 lxl pde e hs smxal) 
    (setq pde nil) 
    (setq smxal (ssget "x" '((8 . "mx")))) 
    (if(or (= fx 0) (= fx 2)) 
      (setq lxl (list (car pds))) 
      (setq lxl (list (cadr pds))) 
    ) 
    (while (setq e (ssname smxal 0)) 
      (setq p1 (cdr (assoc 10 (entget e))) 
            p2 (cdr (assoc 10 (reverse (entget e)))) 
      ) 
      (if (or (= fx 0) (= fx 2)) 
        (if (and (equal (cadr p1) (cadr pds) 0.001) 
                 (equal (cadr p2) (cadr pds) 0.001) 
            ) 
          (if (> (setq hs (max (car p1) (car p2))) (car pds)) 
            (setq lxl (cons hs lxl)) 
          ) 
        ) 
        (if (and (equal (car p1) (car pds) 0.001) 
                 (equal (car p2) (car pds) 0.001) 
            ) 
          (if (> (setq hs (max (cadr p1) (cadr p2))) (cadr pds)) 
            (setq lxl (cons hs lxl)) 
          ) 
        ) 
      ) 
      (ssdel e smxal) 
    ) 
    (if(> (length lxl) 1) 
      (setq lxl (qsort h_comp lxl)) 
    ) 
    (while (and        (> (length lxl) 1) 
                (< (- (cadr lxl) (car lxl)) (* 1.5 hljj)) 
           ) 
      (setq lxl (cdr lxl)) 
      (if (or (= fx 0) (= fx 2)) 
        (setq pde (list(car lxl)(cadr pds)        0.0)) 
        (setq pde (list(car pds)(car lxl)        0.0)) 
      ) 
    ) 
    pde 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_lxxz 
;;功能: 连续回路选择,选择由一点开始的所有连续同方向回路 
;;输入: 开始点 结束点 方向 
;;返回: 选择集 
  (defun h_lxxz        (pds pde fx / p1 p2 ss i ls emx dqw1 wzpdt) 
    (setq ss nil) 
    (if        (and pds pde) 
      (progn 
        (cond 
          ((= fx 0) 
           (setq p1 (polar pds (* 1.5 pi) (* 90 tscale)) 
                 p2 (polar pde (* 0.5 pi) (* 2 tscale)) 
           ) 
          ) 
          ((= fx 1) 
           (setq p1 (polar pds pi (* 2 tscale)) 
                 p2 (polar pde 0 (* 90 tscale)) 
           ) 
          ) 
          ((= fx 2) 
           (setq p1 (polar pds (* 1.5 pi) (* 2 tscale)) 
                 p2 (polar pde (* 0.5 pi) (* 90 tscale)) 
           ) 
          ) 
          ((= fx 3) 
           (setq p1 (polar pds pi (* 90 tscale)) 
                 p2 (polar pde 0 (* 2 tscale)) 
           ) 
          ) 
        ) 
        (setq dqw1 (XScjx)) 
        (if (or        (= (h_inwi p1 (car dqw1) (cadr dqw1)) 1) 
                (= (h_inwi p2 (car dqw1) (cadr dqw1)) 1) 
            ) 
          (progn 
            (command "_.zoom" 
                     (list (min (car p1) (caar dqw1)) 
                           (min (cadr p1) (cadar dqw1)) 
                     ) 
                     (list (max (car p2) (caadr dqw1)) 
                           (max (cadr p2) (cadadr dqw1)) 
                     ) 
            ) 
          ) 
        ) 
        (setq ss (ssget "c" p1 p2 '((8 . "mx,bxt,fah,xhgg,xmdh")))) 
 
        (setq i         0 
              ls (sslength ss) 
        ) 
        (repeat        ls 
          (setq emx (ssname ss i)) 
          (setq wzpdt (h_wzpd emx p1 p2 ss)) 
          (if (or (null wzpdt) (= wzpdt t)) 
            (ssdel emx ss) 
            (setq i (1+ i)) 
          ) 
        ) 
      ) 
    ) 
    ss 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_hlhz 
;;功能: 回路绘制 
;;输入: 回路起始点 方向 回路间距 
;;返回: 无 
  (defun h_hlhz(pjd fx dist data1 data2 sm2 / zdist pds pdmx2 pdmx1 mxkd shu) 
    (setq zdist (* sm2 dist)) 
    (Xsetin "Hlklib" "Hlkjj" (rtos (/ dist tscale) 2 2) 1) 
    (shldy pjd fx data1 data2)                ;回路绘制 
    (command "_.color" "_green") 
    (command "_.Layer" "_m" "mx" "_c" 3 "" "") 
    (if        (or (= fx 0) (= fx 2)) 
      (setq pds (polar pjd 0 (* -0.5 zdist))) 
      (setq pds (polar pjd (* 0.5 pi) (* -0.5 zdist))) 
    ) 
    (setq pdmx1 pds) 
    (repeat sm2 
      (if (or (= fx 0) (= fx 2)) 
        (setq pdmx2 (polar pdmx1 0 dist)) 
        (setq pdmx2 (polar pdmx1 (* 0.5 pi) dist)) 
      ) 
      (setq mxkd (atof (Xgetin "Hlklib" "Hlkmx" "0.6" 1))) 
      (setq mxkd (* mxkd tscale)) 
      (command "_.pline" pdmx1 "_w" mxkd "" pdmx2 "") 
      (setq pdmx1 pdmx2) 
    )                                        ;母线绘制 
    (setq shu(tblsearch "layer""GDXT")) 
    (if shu(command "_.layer" "_set" "GDXT" "")) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_sh1 
;;功能: 回路替换 
;;输入: 无 
;;返回: 无 
(defun h_sh1(/ lll1 ph1 ph2 ttt1 hlxzl pjd fx kd sshl hlsm lll2 ttt2 ph3 ph4 
               lxfs slx        pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj 
               jjn sshl hldata data1 data2 dist sm2 smov zxj ysj zxjn ysjn mylist 
               plist xlist ylist ess fan i shu) 
  (setq zxj (car(XScjx))) 
  (setq ysj (last(XScjx))) 
  (setq lll1 t) 
  (while lll1 
    (command "_.undo" "_group") 
    (setq shu(tblsearch "layer""GDXT")) 
    (if shu(command "_.layer" "_set" "GDXT" "")) 
    (setq fan 1) 
    (prompt "\n请用窗口(W)选择被替回路:") 
    (setq ph1 1) 
    (while (not(listp ph1)) 
      (initget 128) 
      (setq ph1 (getpoint "\n请输入窗口第一点<回车结束>:")) 
    ) 
    (if ph1 
      (progn 
        (setq ttt1 t) 
        (while ttt1 
          (setq ph2 1) 
          (while (not(listp ph2)) 
            (initget 128) 
            (setq ph2 (getcorner ph1 "\n请输入窗口第二点:")) 
          ) 
          (if ph2 
            (progn 
              (setq hlxzl (h_xzhl ph1 ph2)) 
              (if hlxzl 
                (progn 
                  (setq ttt1 nil) 
                  (setq        pjd  (nth 0 hlxzl) 
                        fx   (nth 1 hlxzl) 
                        kd   (nth 2 hlxzl) 
                        sshl (nth 3 hlxzl) 
                        hlsm (nth 4 hlxzl) 
                  ) 
                  (setq i 0) 
                  (repeat (sslength sshl) 
                    (redraw (ssname sshl i) 3) 
                    (setq i (1+ i)) 
                  ) 
                  (setq lxfs 1 slx  sshl) 
                  (if(=(IfWndVis "hlklibclass") 0) 
                    (hlklib 0 1 "s" 0 1 1 0 0) 
                    (progn 
                      (xsetin "Hlklib" "Hlkpara" "0&1&0&1&1&0&0" 1) 
                      (xsetin "Hlklib" "RetHlkMes" "s" 1) 
                    ) 
                  ) 
                  (setq lll2 t) 
                  (while lll2 
                    (prompt "\n请用窗口(W)或从图库选择替换回路:") 
                    (setq ph3 1) 
                    (while (and(/= ph3 "s")(not(listp ph3))) 
                      (initget 128 "s") 
                      (setq ph3(getpoint"\n请输入窗口第一点或请选取方案<回车结束>:")) 
                    ) 
                    (cond 
                      ((and(listp ph3)ph3) 
                       (setq ttt2 t) 
                       (while ttt2 
                         (setq ph4 1) 
                         (while(not(listp ph4)) 
                           (initget 128) 
                           (setq ph4(getcorner ph3 "\n请输入窗口第二点:")) 
                         ) 
                         (if ph4 
                           (progn 
                             (setq hlxzln (h_xzhl ph3 ph4)) 
                             (if hlxzln 
                               (progn 
                                 (setq pjdf  (nth 0 hlxzln) 
                                       fxn   (nth 1 hlxzln) 
                                       kdn   (nth 2 hlxzln) 
                                       sshln (nth 3 hlxzln) 
                                       hlsmn (nth 4 hlxzln) 
                                 ) 
                                 (setq jj(/ kd hlsm) jjn (/ kdn hlsmn)) 
                                 (if (and (equal jj jjn 0.01)(= fx fxn)) 
                                   (progn 
                                     (setq ttt2 nil lll2 nil) 
                                     (if (or (= fx 0) (= fx 2)) 
                                       (setq pjdn  (polar pjd 0 (/ (- kdn kd) 2.0)) 
                                             pmds  (polar pjd 0 (/ kd 2.0)) 
                                             pmdsn (polar pmds 0(- kdn kd)) 
                                       ) 
                                       (setq pjdn  (polar pjd (* 0.5 pi) (/ (- kdn kd) 2.0)) 
                                             pmds  (polar pjd (* 0.5 pi) (/ kd 2.0)) 
                                             pmdsn (polar pmds(* 0.5 pi) (- kdn kd)) 
                                       ) 
                                     ) 
                                     (setq pmde (h_lxdd pmds fx jj)) 
                                     (setq smov (h_lxxz pmds pmde fx)) 
                                     (setq mylist(Dhtss pjd 2)) 
                                     (if(and mylist (or(= fx 0)(= fx 2))) 
                                       (progn 
                                         (setq zxjn (car(XScjx))) 
                                         (setq ysjn (last(XScjx))) 
                                         (C_zoom mylist zxjn ysjn) 
                                         (setq ylist(C_xyzb mylist pjd kd)) 
                                         (setq plist(C_ldel mylist pjd kd sshl)) 
                                         (setq xlist(C_movt plist kd kdn sshln pjdf pjdn smov 0)) 
                                         (setq ess(last plist)) 
                                         (command "_.erase" ess "") 
                                         (command "_.erase" sshl "") 
                                         (command "_.layer" "_set" "GDXT" "") 
                                         (C_slin (car xlist) ylist) 
                                         (C_slin (last xlist) ylist) 
                                         (C_hlin xlist ylist hlsmn) 
                                         (command "_.zoom" zxj ysj) 
                                       ) 
                                       (progn 
                                         (command "_.copy" sshln "" pjdf pjdn) 
                                         (if smov(command "_.move" smov "" pmds pmdsn)) 
                                         (command "_.erase" sshl "") 
                                       ) 
                                     ) 
                                   ) 
                                   (progn 
                                     (Xacino "所选回路的出线方向或间距不对,请重新选择!" "注意" 6) 
                                     (setq ttt2 nil) 
                                   ) 
                                 ) 
                               ) 
                               (setq ttt2 nil) 
                             ) 
                           ) 
                         ) 
                       ) 
                      ) 
                      ((= ph3 "s") 
                       (setq lll2 nil) 
                       (setq hldata (xgetin "Hlklib" "Hlkdata" "" 1)) 
                       (setq data1(_getnS hldata 1 "&") data2(_getnS hldata 2 "&")) 
                       (setq dist (/ kd hlsm)) 
                       (setq sm2 (fhlnum data1 data2)) 
                       (setq kdn (* sm2 dist)) 
                       (if(or(= fx 0)(= fx 2)) 
                         (setq pjdn (polar pjd 0 (/ (- kdn kd) 2.0)) 
                               pmds (polar pjd 0 (/ kd 2.0)) 
                               pmdsn(polar pmds 0 (- kdn kd)) 
                         ) 
                         (setq pjdn (polar pjd(* 0.5 pi)(/ (- kdn kd) 2.0)) 
                               pmds (polar pjd (* 0.5 pi) (/ kd 2.0)) 
                               pmdsn(polar pmds (* 0.5 pi) (- kdn kd)) 
                         ) 
                       ) 
                       (setq pmde (h_lxdd pmds fx dist)) 
                       (setq smov (h_lxxz pmds pmde fx)) 
                       (setq mylist(dhtss pjd 2)) 
                       (if (and mylist (or (= fx 0) (= fx 2))) 
                         (progn 
                           (setq zxjn (car(XScjx)))(setq ysjn (last(XScjx))) 
                           (C_zoom mylist zxjn ysjn) 
                           (setq ylist (C_xyzb mylist pjd kd)) 
                           (setq plist (C_ldel mylist pjd kd sshl)) 
                           (setq xlist (C_movk plist kd kdn pjdn fx dist data1 data2 sm2 smov 1)) 
                           (setq ess (last plist)) 
                           (command "_.erase" ess "") 
                           (command "_.erase" sshl "") 
                           (command "_.layer" "_set" "GDXT" "") 
                           (C_slin (car xlist) ylist) 
                           (C_slin (last xlist) ylist) 
                           (C_hlin xlist ylist sm2) 
                           (command "_.zoom" zxj ysj) 
                         ) 
                         (progn 
                           (if smov(command "_.move" smov "" pmds pmdsn)) 
                           (command "_.erase" sshl "") 
                           (h_hlhz pjdn fx dist data1 data2 sm2) 
                         ) 
                       ) 
                      ) 
                      (t(setq lll2 nil)) ;回车结束 
                    ) 
                  )                              ;替换选取循环 
                ) 
                (setq ttt1 nil) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (setq lll1 nil) 
    )                                        ;是否ph1--t 
    (if(= lxfs 1) 
      (progn 
        (setq i 0) 
        (repeat (sslength slx) 
          (redraw (ssname slx i) 4) 
          (setq i (1+ i)) 
        ) 
        (setq lxfs 0) 
      ) 
    ) 
    (command "_.undo" "_end") 
    (setq fan 0) 
  )                                              ;被替换选取循环 
) 
 
;;================================子函数结束================================== 
  (_inidwg) 
  (princ "\n*回路替换*=Hlth") 
  (setvar "plinetype" 2) 
  (setvar "cmdecho" 0) 
  (setvar "blipmode" 0) 
  (setvar "pickadd" 1) 
  (setvar "osmode" 0) 
  (setvar "CECOLOR" "green") 
  (setq ucmark (getvar "worlducs")) 
  (if (= ucmark 0) 
    (progn 
      (setq ucs_fo (getvar "ucsfollow")) 
      (if (= ucs_fo 1)(setvar "ucsfollow" 0)) 
      (command "_.ucs" "_world") 
    ) 
  ) 
  (setq lxfs 0 tscale(atof(xrddic "Tabscale" "100")) dqw(XScjx)) 
  (setq        o_para(xgetin "Hlklib" "Hlkpara" "" 1) 
        o_mes(xgetin "Hlklib" "RetHlkMes" "" 1) 
        o_jj(xgetin "Hlklib" "Hlkjj" "30" 1) 
  ) 
  (menucmd "s=hd25l") 
  (h_sh1) 
  (if(= ucmark 0)(command "_.ucs" "_prev")) 
  (setvar "highlight" 1) 
  (setq dqwn(XScjx)) 
  (if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw))) 
  (setq *error* olderr olderr nil) 
  (_resdwg) 
  (princ) 
) 
 
;;=================================主程序开始================================= 
;;名称：C:HLHH 
;;功能：简版回路编辑-回路互换 
;;输入：无 
;;返回：无 
(defun C:HLHH(/ tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo 
                h_sh2 h_XZHL h_WZYZ h_HLHZ h_LXDD h_WZPD h_LXXZ h_mxwz h_inwi 
                h_comp C_zoom C_ssgl C_xyzb C_ldel C_movt C_movk C_hlin C_slin 
                s_px) 
  (setq olderr *error*) 
   
;;=================================子函数开始================================= 
;;名称：*error*(错误处理函数) 
;;功能：当程序发生错误或用户中断时，平静地退出，并还原状态。 
;;输入：无 
;;返回：无 
(defun *error* (msg / each) 
  (if (= fan 1)(command "_.undo" "_end")) 
  (if (= fan 1)(command "_.undo" "")) 
  (if (= ucmark 0) (command "_.ucs" "_prev")) 
  (xsetin "Hlklib" "Hlkpara" o_para 1) 
  (xsetin "Hlklib" "RetHlkMes" o_mes 1) 
  (xsetin "Hlklib" "Hlkjj" o_jj 1) 
  (if(= lxfs 1) 
    (progn(setq i 0)(repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i)))) 
  ) 
  (setq dqwn (XScjx)) 
  (if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw))) 
  (foreach each 
      '(tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo h_sh2 h_xzhl 
        h_wzyz h_hlhz h_lxdd h_wzpd h_lxxz h_mxwz h_inwi h_comp C_zoom C_ssgl C_xyzb 
        C_ldel C_movt C_movk C_hlin C_slin point1 point2 i ename point3 point4 ss 
        elist point5 point6 biao ylist plist l xlist n nylist s_px yy list1 list2 a b 
        emx p1 p2 p3 pd1 pd2 pc mxwzt wzt npd1 npd2 es sins first fxhsf hszf pmxd1 
        pmxd2 fxhs hsz wzyz ssfah fah pjd fx sshl hlsm kd hll smx mxt len1 ii iii mxmin 
        mxmax i4 pcl e pcxl pcyl pcc xzt len2 pds hljj lxl pde hs smxal ls dqw1 wzpdt 
        dist data1 data2 sm2 zdist pdmx2 mxkd lll1 ph1 ph2 ttt1 hlxzl lll2 ttt2 ph3 ph4 
        slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj jjn hldata smov zxj 
        ysj zxjn ysjn mylist ess fan name laye yanse hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 pjd2 
        fx2 kd2 hlsm2 hlxzl2 pjdn1 pjd1n pjd2n pme smov1 smov2 pmds1 pmds1n pmds2 pmds2n 
        pmde1 pmde2 jj1 jj2 sshl2 s2_ss3 s2_lsx ss1 ss2 ss3 ylist1 ylist2 plist1 plist2 
        xlist1 xlist2 ess1 ess2 point shu xzb) 
      (set each nil) 
    ) 
    (setq each nil) 
    (setq *error* olderr olderr nil) 
    (_resdwg) 
    (princ) 
) 
 
;;=================================子函数开始================================= 
;;名称：C_zoom 
;;功能：判断是否zoom 
;;输入：mylist-订货图的角表 zxj-视区左下角 ysj-视区右上角 
;;返回：无 
(defun C_zoom(mylist zxjn ysjn / point1 point2) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (if(or(>(car zxjn)(car point2))(<(car ysjn)(car point1)) 
        (>(cadr zxjn)(cadr point1))(<(cadr ysjn)(cadr point2)) 
     ) 
    (command "_.ZOOM" "_w" point1 point2) 
  ) 
) 
 
;;=================================子函数开始================================= 
;;名称：C_ssgl 
;;功能：过滤选择集 
;;输入：ss1-选择集1 ss2-选择集2 
;;返回：ss1 
 (defun C_ssgl(ss1 ss2 / i ename) 
  (setq i 0) 
  (repeat(sslength ss2) 
    (setq ename (ssname ss2 i)) 
    (ssdel ename ss1) 
    (setq i (+ i 1)) 
  ) 
  ss1 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_xyzb 
;;功能：得到所选回路所有横线的Y坐标点集 
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 
;;返回：ylist-所选回路所有横线的Y坐标表 
 (defun C_xyzb(mylist pjd kd / point1 point2 point3 point4 i ss ename elist 
                                   point5 point6 biao ylist) 
  (setq ylist '()) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2))) 
  (setq point4(list(+(car point3)kd)(cadr point1)(last point1))) 
  (setq ss (ssget "W" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3)))) 
  (setq i 0) 
  (repeat (sslength ss) 
    (setq ename (ssname ss i)) 
    (setq elist (entget ename)) 
    (setq point5(cdr(assoc 10 elist))) 
    (setq point6(cdr(assoc 11 elist))) 
    (if (equal(cadr point5)(cadr point6)0.1) 
      (progn 
        (setq biao(member (cadr point5) ylist)) 
        (if (not biao) 
          (setq ylist(cons (cadr point5) ylist)) 
        ) 
      ) 
    ) 
    (setq i (+ i 1)) 
  ) 
  ylist 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_ldel 
;;功能：得到所选回路列的左上角和右下角 
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 sshl-回路选择集 
;;返回：plist-点表(所选回路列的右上角、订货图的右下角和所选回路列的选择集) 
 (defun C_ldel(mylist pjd kd sshl / point1 point2 point3 point4 point5 ss plist) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2))) 
  (setq point4(list(+(car pjd)(/ kd 2))(cadr point1)(last point2))) 
  (setq ss(ssget "w" point3 point4)) 
  (setq ss(C_ssgl ss sshl)) 
  (setq point5(list(car point4)(cadr point2)(last point2))) 
  (setq plist (list point5 point1 ss)) 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_movt 
;;功能：copy回路并移动表格(从当前图中copy或move) 
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度 
;;      sshln-替换回路 pjdf-替换回路的基点 pjd-被替回路的基点 smov-回路选择集 
;;      a-为0时拷贝,为1时移动,为2时插入 
;;返回：xlist-新回路列的x坐标 
(defun C_movt(plist kd kdn sshln pjdf pjdn smov a / point1 point2 l point3 point4 xlist ss) 
  (setq point1(car plist)) 
  (setq point2(cadr plist)) 
  (if(or(= a 0)(= a 1)) 
    (progn 
      (setq l(- kd kdn)) 
      (setq point3(list(-(car point1)l)(cadr point1)(last point1))) 
      (setq ss(ssget "w" point1 point2)) 
      (if (= a 0) 
        (command "_.copy" sshln "" pjdf pjdn) 
        (command "_.move" sshln "" pjdf pjdn) 
      ) 
      (if smov 
        (progn 
          (command "_.move" smov "" point1 point3) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point1 point3) 
      (setq xlist(list(-(car point1)kd)(car point3))) 
    ) 
    (progn 
      (setq point3(list(-(car point1)kd)(cadr point1)(last point1))) 
      (setq point4(list(+(car point3)kdn)(cadr point3)(last point3))) 
      (setq ss (ssget "w" point3 point2)) 
      (command "_.copy" sshln "" pjdf pjdn) 
      (if smov 
        (progn 
          (command "_.move" smov "" point3 point4) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point3 point4) 
      (setq xlist(list(car point3)(car point4))) 
    ) 
  ) 
  xlist 
) 
 
;;=================================子函数开始================================= 
;;名称：C_movk 
;;功能：copy回路并移动表格(从图库中取) 
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度 
;;      pjdn-替换回路 fx-回路方向 dist、data1、data2、sm2-调回路库的参数 smov-回路选择集 
;;      a-为时替换回路,为2时插入回路 
;;返回：xlist-新回路列的两个x坐标 
(defun C_movk(plist kd kdn pjdn fx dist data1 data2 sm2 smov a / point1 point2 l point3 
              point4 xlist ss) 
  (setq point1(car plist)) 
  (setq point2(cadr plist)) 
  (if (= a 1) 
    (progn 
      (setq l(- kd kdn)) 
      (setq point3(list(-(car point1)l)(cadr point1)(last point1))) 
      (setq ss(ssget "w" point1 point2)) 
      (h_hlhz pjdn fx dist data1 data2 sm2) 
      (if smov 
        (progn 
          (command "_.move" smov "" point1 point3) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point1 point3) 
      (setq xlist(list(-(car point1)kd)(car point3))) 
    ) 
    (progn 
      (setq point3(list(-(car point1)kd)(cadr point1)(last point1))) 
      (setq point4(list(+(car point3)kdn)(cadr point3)(last point3))) 
      (setq ss (ssget "w" point3 point2)) 
      (h_hlhz pjdn fx dist data1 data2 sm2) 
      (if smov 
        (progn 
          (command "_.move" smov "" point3 point4) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point3 point4) 
      (setq xlist(list(car point3)(car point4))) 
    ) 
  ) 
  xlist 
) 
 
;;=================================子函数开始================================= 
;;名称：C_hlin 
;;功能：画横线 
;;输入：xlist-新订货图的x坐标表 ylist-所选订货图所有横线的Y坐标表 hlsm-回路数目 
;;返回：无 
(defun C_hlin(xlist ylist hlsm / point1 point2 i l n) 
  (setq i 0) 
  (setq l(/(abs(-(car xlist)(last xlist)))hlsm)) 
  (repeat (length ylist) 
    (setq n 0) 
    (repeat hlsm 
      (setq point1(list(+(car xlist)(* l n))(nth i ylist)0.0)) 
      (setq point2(list(+(car xlist)(* l (+ n 1)))(nth i ylist)0.0)) 
      (command "_.line" point1 point2 "") 
      (setq n (+ n 1)) 
    ) 
    (setq i (+ i 1)) 
  ) 
) 
 
;;=================================子函数开始================================= 
;;名称：s_px 
;;功能：排序(从大到小) 
;;输入：ylist-所选订货图所有横线的Y坐标表 
;;返回：nylist 
  (defun s_px(ylist / i nylist yy list1 list2) 
    (setq nylist '()) 
    (while (/= (length ylist) 0) 
      (setq i 1) 
      (setq yy (nth 0 ylist)) 
      (repeat (-(length ylist)1) 
        (if (> yy (nth i ylist)) 
          (setq yy (nth i ylist)) 
        ) 
        (setq i (+ i 1)) 
      ) 
      (setq nylist (cons yy nylist)) 
      (setq list1 (cdr (member yy ylist))) 
      (setq list2 (cdr (member yy (reverse ylist)))) 
      (setq ylist (append list1 list2)) 
    ) 
    nylist 
  ) 
 
;;=================================子函数开始================================= 
;;名称：C_slin 
;;功能：画竖线 
;;输入：xzb-x坐标 ylist-所选订货图所有横线的Y坐标表 
;;返回：无 
 (defun C_slin(xzb ylist / nylist point1 point2 i) 
  (setq i 0) 
  (setq nylist(s_px ylist)) 
  (repeat (-(length nylist)1) 
    (setq point1(list xzb (nth i nylist))) 
    (setq point2(list xzb (nth (+ i 1) nylist))) 
    (command "_.line" point1 point2 "") 
    (setq i (+ i 1)) 
  ) 
 ) 
   
;;=================================子函数开始================================= 
;;名称：h_comp 
;;功能：计算两值的差(用于排序) 
;;输入：a、b 
;;返回：两值的差 
  (defun h_comp (a b) 
    (- a b) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_inwi 
;;功能: 判断p1是否在p2 p3组成的窗口内 
;;输入: p1 p2 p3 
;;返回: 0-在窗口内、1-在窗口外、nil-边界上 
  (defun h_inwi (p1 p2 p3) 
    (cond 
      ((and(< (car p1) (- (max (car p2) (car p3)) tscale)) 
            (> (car p1) (+ (min (car p2) (car p3)) tscale)) 
            (< (cadr p1) (- (max (cadr p2) (cadr p3)) tscale)) 
            (> (cadr p1) (+ (min (cadr p2) (cadr p3)) tscale)) 
        ) 
        0 
      ) 
      ((or(> (car p1) (+ (max (car p2) (car p3)) tscale)) 
           (< (car p1) (- (min (car p2) (car p3)) tscale)) 
           (> (cadr p1) (+ (max (cadr p2) (cadr p3)) tscale)) 
           (< (cadr p1) (- (min (cadr p2) (cadr p3)) tscale)) 
        ) 
        1 
      ) 
      (t nil) 
    ) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_mxwz 
;;功能: 母线位置判断 
;;输入: emx p1 p2 
;;返回: mxwzt 
  (defun h_mxwz        (emx p1 p2 / pd1 pd2 pc mxwzt) 
    (setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
          pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
    ) 
    (setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0))) 
    (if        (or (> (car pc) (max (car p1) (car p2))) 
            (> (cadr pc) (max (cadr p1) (cadr p2))) 
            (< (car pc) (min (car p1) (car p2))) 
            (< (cadr pc) (min (cadr p1) (cadr p2))) 
        ) 
      (setq mxwzt nil) 
      (setq mxwzt pc) 
    ) 
    mxwzt 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_wzpd 
;;功能: 位置判断、判断实体（块-插入点，线-二端点）是否在窗口之内 
;;输入: 实体名 窗口二角点 
;;返回: 在窗口内-中点 
;;      不在窗口内-T 
;;      交叉(线)-nil 
  (defun h_wzpd (emx p1 p2 ss / pd1 pd2 pc wzt npd1 npd2 es sins i) 
    (cond 
      ((= (cdr (assoc 0 (entget emx))) "LWPOLYLINE") 
       (setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
             pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
       ) 
       (setq pc        (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0))) 
       (setq npd1 (h_inwi pd1 p1 p2) 
             npd2 (h_inwi pd2 p1 p2) 
       ) 
       (cond 
        ((or(and (= npd1 0) (= npd2 1))(and (= npd2 0) (= npd1 1))) 
         (setq wzt nil) 
        ) 
         ((or (= npd1 1) (= npd2 1)) 
          (setq wzt t) 
         ) 
         (t (setq wzt pc)) 
       ) 
      ) 
      (t 
       (setq pc (cdr (assoc 10 (entget emx)))) 
       (cond 
        ((= (h_inwi pc p1 p2) 1) 
          (setq wzt t) 
         ) 
         ((null (h_inwi pc p1 p2)) 
          (if (= (cdr (assoc 0 (entget emx))) "insert") 
            (progn 
              (setq        sins (ssget "c" 
                                    (polar pc (* 0.25 pi) tscale) 
                                    (polar pc (* 0.25 pi) tscale) 
                                    '((0 . "insert,lwpolyline")) 
                             ) 
                  ) 
                  (setq        wzt pc 
                        i   0 
                  ) 
                  (while (and wzt (
                    (setq es (ssname sins i)) 
                    (if        (not (ssmemb es sins)) 
                      (setq wzt t) 
                      (setq i (1+ i)) 
                    ) 
                  ) 
                ) 
                (setq wzt pc) 
              ) 
             ) 
             (t (setq wzt pc)) 
       ) 
      ) 
    ) 
    wzt 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_wzyz 
;;功能: 母线位置一致性判断 
;;输入: 母线 循环号 (方向初值 坐标初值) 
;;返回: i=0 (方向 坐标) 
;;      i/=0 位置一致 t 
;;           位置不一致 nil 
  (defun h_wzyz        (emx i first / fxhsf hszf pmxd1 pmxd2 fxhs hsz wzyz) 
    (setq fxhsf        (car first) 
          hszf        (cadr first) 
    ) 
    (setq pmxd1        (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
          pmxd2        (append        (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
    ) 
    (if(equal (car pmxd1) (car pmxd2) 0.001) 
      (setq fxhs 1 hsz (car pmxd1)) 
      (setq fxhs 0 hsz (cadr pmxd1)) 
    ) 
    (if(= i 0) 
      (setq wzyz (list fxhs hsz)) 
      (progn 
        (if (or(not (equal fxhs fxhsf 0.01)) 
                (not (equal hsz hszf 0.01)) 
            ) 
         (setq wzyz nil) 
          (setq wzyz t) 
        ) 
      ) 
    ) 
    wzyz 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_xzhl 
;;功能: 选择回路 
;;输入: 窗口二角点p1，p2 
;;返回: t-(基点 方向? 宽度 回路选择集 回路数) 方向--0 向下 1 向右 2 向上 3 向左 
;;       NIL-nil 
  (defun h_xzhl        (p1    p2    /           ssfah fah   pjd   fx           sshl         hlsm 
                 kd    hll   smx   i         mxt   fxhs  hsz   len1         ii 
                 emx   iii   pd1   pd2         mxmin mxmax p1           p2         pc 
                 ss    i4    pcl   first e     pcxl  pcyl  pcc   xzt 
                 len2 
                ) 
    (setq hll nil) 
    (setq smx (ssget "c" p1 p2 '((0 . "lwpolyline") (8 . "mx")))) 
    (if        smx 
      (progn 
        (setq i        0 mxt t) 
        (while (and mxt (
          (setq emx (ssname smx i)) 
          (if (= i 0) 
            (setq first (h_wzyz emx 0 nil)) 
            (setq mxt (h_wzyz emx i first)) 
          ) 
          (setq i (1+ i)) 
        )                                ;判断母线位置一致性 
        (if mxt 
          (progn 
            (setq fxhs (car first) 
                  hsz  (cadr first) 
                  ii   0 
                  len1 (sslength smx) 
            ) 
            (repeat len1 
              (setq emx (ssname smx ii)) 
              (if (h_mxwz emx p1 p2) 
                (setq ii (1+ ii)) 
                (ssdel emx smx) 
              ) 
            )                                ;删除中心在边界外的母线 
            (setq hlsm (sslength smx)) 
            (if        (/= hlsm 0) 
              (progn 
                (setq iii 0) 
                (repeat        hlsm 
                  (setq emx (ssname smx iii)) 
                  (setq        pd1 (cdr (assoc 10 (entget emx))) 
                        pd2 (cdr (assoc 10 (reverse (entget emx)))) 
                  ) 
                  (if (= fxhs 0) 
                    (if        (= iii 0) 
                      (setq mxmin (min (car pd1) (car pd2)) 
                            mxmax (max (car pd1) (car pd2)) 
                      ) 
                      (progn 
                        (if (< (min (car pd1) (car pd2)) mxmin) 
                          (setq mxmin (min (car pd1) (car pd2))) 
                        ) 
                        (if (> (max (car pd1) (car pd2)) mxmax) 
                          (setq mxmax (max (car pd1) (car pd2))) 
                        ) 
                      ) 
                    ) 
                    (if        (= iii 0) 
                      (setq mxmin (min (cadr pd1) (cadr pd2)) 
                            mxmax (max (cadr pd1) (cadr pd2)) 
                      ) 
                      (progn 
                        (if (< (min (cadr pd1) (cadr pd2)) mxmin) 
                          (setq mxmin (min (cadr pd1) (cadr pd2))) 
                        ) 
                        (if (> (max (cadr pd1) (cadr pd2)) mxmax) 
                          (setq mxmax (max (cadr pd1) (cadr pd2))) 
                        ) 
                      ) 
                    ) 
                  ) 
                  (setq iii (1+ iii)) 
                ) 
                (setq kd (- mxmax mxmin)) 
                (if (= fxhs 0) 
                  (setq        p1  (list mxmin (cadr p1) 0.0) 
                        p2  (list mxmax (cadr p2) 0.0) 
                        pjd (list (/ (+ mxmin mxmax) 2) hsz 0.0) 
                  ) 
                  (setq        p1  (list (car p1) mxmin 0.0) 
                        p2  (list (car p2) mxmax 0.0) 
                        pjd (list hsz (/ (+ mxmin mxmax) 2) 0.0) 
                  ) 
                )                        ;取得母线范围并更新选择集窗口 
 
                (setq ss (ssget "c" p1 p2 '((8 . "mx,fah,bxt,xhgg,xmdh")))) 
                (setq i4   0 
                      pcl  nil 
                      len2 (sslength ss) 
                      xzt  t 
                ) 
                (while (and xzt (< i4 len2)) 
                  (setq e (ssname ss i4)) 
                  (if (setq pc (h_wzpd e p1 p2 smx)) 
                    (progn 
                      (if (= pc t) 
                        (progn 
                          (ssdel e ss) 
                          (setq len2 (1- len2)) 
                        ) 
                        (progn 
                          (setq pcl (cons pc pcl)) 
                          (setq i4 (1+ i4)) 
                        ) 
                      ) 
                    ) 
                    (setq xzt nil) 
                  ) 
                ) 
                                        ;去掉多余实体,如果交叉结束 
                (if xzt 
                  (progn 
                    (setq pcxl (mapcar 'car pcl) 
                          pcyl (mapcar 'cadr pcl) 
                    ) 
                    (setq pcc (list (/ (apply '+ pcxl) (length pcl)) 
                                    (/ (apply '+ pcyl) (length pcl)) 
                                    0.0 
                              ) 
                    ) 
                    (if        (= fxhs 0) 
                      (if (< (cadr pcc) (cadr pjd)) 
                        (setq fx 0) 
                        (setq fx 2) 
                      ) 
                      (if (> (car pcc) (car pjd)) 
                        (setq fx 1) 
                        (setq fx 3) 
                      ) 
                    ) 
                    (setq hll (list pjd fx kd ss hlsm)) 
                  ) 
                  (Xacino "回路选择不完整!" "操作错误" 6) 
                ) 
              ) 
            ) 
          ) 
          (Xacino "选了其他回路的母线!" "操作错误" 6) 
        ) 
      ) 
    ) 
    hll 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_lxdd 
;;功能: 连续母线端点 
;;输入: 端点 方向 
;;返回: 下一端点 
  (defun h_lxdd        (pds fx hljj / p1 p2 lxl pde e hs smxal) 
    (setq pde nil) 
    (setq smxal (ssget "x" '((8 . "mx")))) 
    (if(or (= fx 0) (= fx 2)) 
      (setq lxl (list (car pds))) 
      (setq lxl (list (cadr pds))) 
    ) 
    (while (setq e (ssname smxal 0)) 
      (setq p1 (cdr (assoc 10 (entget e))) 
            p2 (cdr (assoc 10 (reverse (entget e)))) 
      ) 
      (if (or (= fx 0) (= fx 2)) 
        (if (and (equal (cadr p1) (cadr pds) 0.001) 
                 (equal (cadr p2) (cadr pds) 0.001) 
            ) 
          (if (> (setq hs (max (car p1) (car p2))) (car pds)) 
            (setq lxl (cons hs lxl)) 
          ) 
        ) 
        (if (and (equal (car p1) (car pds) 0.001) 
                 (equal (car p2) (car pds) 0.001) 
            ) 
          (if (> (setq hs (max (cadr p1) (cadr p2))) (cadr pds)) 
            (setq lxl (cons hs lxl)) 
          ) 
        ) 
      ) 
      (ssdel e smxal) 
    ) 
    (if(> (length lxl) 1) 
      (setq lxl (qsort h_comp lxl)) 
    ) 
    (while (and        (> (length lxl) 1) 
                (< (- (cadr lxl) (car lxl)) (* 1.5 hljj)) 
           ) 
      (setq lxl (cdr lxl)) 
      (if (or (= fx 0) (= fx 2)) 
        (setq pde (list(car lxl)(cadr pds)        0.0)) 
        (setq pde (list(car pds)(car lxl)        0.0)) 
      ) 
    ) 
    pde 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_lxxz 
;;功能: 连续回路选择,选择由一点开始的所有连续同方向回路 
;;输入: 开始点 结束点 方向 
;;返回: 选择集 
  (defun h_lxxz        (pds pde fx / p1 p2 ss i ls emx dqw1 wzpdt) 
    (setq ss nil) 
    (if        (and pds pde) 
      (progn 
        (cond 
          ((= fx 0) 
           (setq p1 (polar pds (* 1.5 pi) (* 90 tscale)) 
                 p2 (polar pde (* 0.5 pi) (* 2 tscale)) 
           ) 
          ) 
          ((= fx 1) 
           (setq p1 (polar pds pi (* 2 tscale)) 
                 p2 (polar pde 0 (* 90 tscale)) 
           ) 
          ) 
          ((= fx 2) 
           (setq p1 (polar pds (* 1.5 pi) (* 2 tscale)) 
                 p2 (polar pde (* 0.5 pi) (* 90 tscale)) 
           ) 
          ) 
          ((= fx 3) 
           (setq p1 (polar pds pi (* 90 tscale)) 
                 p2 (polar pde 0 (* 2 tscale)) 
           ) 
          ) 
        ) 
        (setq dqw1 (XScjx)) 
        (if (or        (= (h_inwi p1 (car dqw1) (cadr dqw1)) 1) 
                (= (h_inwi p2 (car dqw1) (cadr dqw1)) 1) 
            ) 
          (progn 
            (command "_.zoom" 
                     (list (min (car p1) (caar dqw1)) 
                           (min (cadr p1) (cadar dqw1)) 
                     ) 
                     (list (max (car p2) (caadr dqw1)) 
                           (max (cadr p2) (cadadr dqw1)) 
                     ) 
            ) 
          ) 
        ) 
        (setq ss (ssget "c" p1 p2 '((8 . "mx,bxt,fah,xhgg,xmdh")))) 
 
        (setq i         0 
              ls (sslength ss) 
        ) 
        (repeat        ls 
          (setq emx (ssname ss i)) 
          (setq wzpdt (h_wzpd emx p1 p2 ss)) 
          (if (or (null wzpdt) (= wzpdt t)) 
            (ssdel emx ss) 
            (setq i (1+ i)) 
          ) 
        ) 
      ) 
    ) 
    ss 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_hlhz 
;;功能: 回路绘制 
;;输入: 回路起始点 方向 回路间距 
;;返回: 无 
  (defun h_hlhz(pjd fx dist data1 data2 sm2 / zdist pds pdmx2 pdmx1 mxkd shu) 
    (setq zdist (* sm2 dist)) 
    (Xsetin "Hlklib" "Hlkjj" (rtos (/ dist tscale) 2 2) 1) 
    (shldy pjd fx data1 data2)                ;回路绘制 
    (command "_.color" "_green") 
    (command "_.Layer" "_m" "mx" "_c" 3 "" "") 
    (if        (or (= fx 0) (= fx 2)) 
      (setq pds (polar pjd 0 (* -0.5 zdist))) 
      (setq pds (polar pjd (* 0.5 pi) (* -0.5 zdist))) 
    ) 
    (setq pdmx1 pds) 
    (repeat sm2 
      (if (or (= fx 0) (= fx 2)) 
        (setq pdmx2 (polar pdmx1 0 dist)) 
        (setq pdmx2 (polar pdmx1 (* 0.5 pi) dist)) 
      ) 
      (setq mxkd (atof (Xgetin "Hlklib" "Hlkmx" "0.6" 1))) 
      (setq mxkd (* mxkd tscale)) 
      (command "_.pline" pdmx1 "_w" mxkd "" pdmx2 "") 
      (setq pdmx1 pdmx2) 
    )                                        ;母线绘制 
    (setq shu(tblsearch "layer""GDXT")) 
    (if shu(command "_.layer" "_set" "GDXT" "")) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_sh2 
;;功能: 回路互换 
;;输入: 无 
;;返回: 无 
(defun h_sh2 (/ lll1 ph1 ph2 ttt1 hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 lll2 ttt2 pjd2 
                fx2 kd2 hlsm2 hlxzl2 ph3 ph4 lxfs slx pjdn1 pjd1n pjd2n e pme 
                smov1 smov2 smov pmds1 pmds1n pmds2 pmds2n pmde1 pmde2 jj1 jj2 
                sshl2 dist zxj ysj zxjn ysjn s2_ss3 s2_lsx mylist ss1 ss2 ss3 
                list1 list2 ylist1 ylist2 plist1 plist2 xlist1 xlist2 ess1 ess2 
                fan i fx shu) 
 
;;=================================子函数开始================================= 
;;名称: s2_ss3 
;;功能: 同一回路中的元件互换时，所选两回路间的定货图 
;;输入: pmds1 pme mylist 
;;返回: ss 
(defun s2_ss3(pmds1 pme mylist / ss point1 point2 point3 point4) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (setq point3(list(car pmds1)(cadr point1)(last point1))) 
  (setq point4(list(car pme)(cadr point2)(last point2))) 
  (setq ss(ssget "w" point3 point4)) 
) 
 
;;=================================子函数开始================================= 
;;名称: s2_lsx 
;;功能: 滤表格线 
;;输入: ss 
;;返回: ss 
(defun s2_lsx(ss / ename point1 point2 i elist name laye yanse ss1) 
  (setq i 0) 
  (setq ss1 (ssadd)) 
  (repeat (sslength ss) 
    (setq ename(ssname ss i)) 
    (setq elist(entget ename)) 
    (setq name(cdr(assoc 0 elist))) 
    (setq laye(cdr(assoc 8 elist))) 
    (setq yanse(cdr(assoc 62 elist))) 
    (if(and(= name "LINE")(= laye "GDXT")(= yanse 3))(ssadd ename ss1)) 
    (setq i(+ i 1)) 
  ) 
  (if(/=(sslength ss1)0)(setq ss(C_ssgl ss ss1))) 
  ss 
) 
;;h_sh2主函数开始 
  (setq zxj(car(XScjx))) 
  (setq ysj(last(XScjx))) 
  (setq lll1 t) 
  (while lll1 
    (command "_.undo" "_group") 
    (setq shu(tblsearch "layer""GDXT")) 
    (if shu(command "_.layer" "_set" "GDXT" "")) 
    (setq fan 1) 
    (prompt "\n请用窗口(W)选择互换回路(1):") 
    (setq ph1 1) 
    (while(not(listp ph1)) 
      (initget 128) 
      (setq ph1 (getpoint "\n请输入窗口第一点<回车结束>:")) 
    ) 
    (if ph1 
      (progn 
        (setq ttt1 t) 
        (while ttt1 
          (setq ph2 1) 
          (while(not(listp ph2)) 
            (initget 128) 
            (setq ph2 (getcorner ph1 "\n请输入窗口第二点:")) 
          ) 
          (if ph2 
            (progn 
              (setq hlxzl1 (h_xzhl ph1 ph2)) 
              (if hlxzl1 
                (progn 
                  (setq ttt1 nil) 
                  (setq pjd1(nth 0 hlxzl1) fx1(nth 1 hlxzl1) kd1(nth 2 hlxzl1) 
                        sshl1(nth 3 hlxzl1) hlsm1(nth 4 hlxzl1)) 
                  (setq i 0) 
                  (repeat(sslength sshl1)(redraw(ssname sshl1 i)3)(setq i (1+ i))) 
                  (setq lxfs 1 slx  sshl1) 
                  (setq lll2 t) 
                  (while lll2 
                    (prompt "\n请用窗口(W)选择互换回路(2):") 
                    (setq ph3 1) 
                    (while(not(listp ph3)) 
                      (initget 128) 
                      (setq ph3 (getpoint "\n请输入窗口第一点<回车结束>:")) 
                    ) 
                    (if ph3 
                      (progn 
                        (setq ttt2 t) 
                        (while ttt2 
                          (setq ph4 1) 
                          (while (not(listp ph4)) 
                            (initget 128) 
                            (setq ph4(getcorner ph3 "\n请输入窗口第二点:")) 
                          ) 
                          (if ph4 
                            (progn 
                              (setq hlxzl2 (h_xzhl ph3 ph4)) 
                              (if hlxzl2 
                                (progn 
                                  (setq pjd2(nth 0 hlxzl2) fx2(nth 1 hlxzl2) kd2(nth 2 hlxzl2) 
                                        sshl2(nth 3 hlxzl2) hlsm2(nth 4 hlxzl2)) 
                                  (setq jj1(/ kd1 hlsm1) jj2(/ kd2 hlsm2)) 
                                  (if(and(equal jj1 jj2 0.01)(= fx1 fx2)) 
                                    (progn 
                                      (setq ttt2 nil lll2 nil) 
                                      (setq fx fx1) 
                                      (if(or(= fx 0)(= fx 2)) 
                                        (setq pmds1(polar pjd1 0 (/ kd1 2.0)) 
                                              pmds2(polar pjd2 0 (/ kd2 2.0)) 
                                        ) 
                                        (setq pmds1(polar pjd1(* 0.5 pi)(/ kd1 2.0)) 
                                              pmds2(polar pjd2(* 0.5 pi)(/ kd2 2.0)) 
                                        ) 
                                      ) 
                                      (setq pmde1(h_lxdd pmds1 fx jj1) 
                                            pmde2(h_lxdd pmds2 fx jj1) 
                                      ) 
                                      (cond 
                                        ((or(and(null pmde2)(equal pmde1 pmds2 0.01)) 
                                            (and pmde1(equal pmde1 pmde2 0.01) 
                                                 (>(distance2p pmds1 pmde1) 
                                                   (distance2p pmds2 pmde2) 
                                                 ) 
                                            ) 
                                         ) 
                                         (if(or(= fx 0)(= fx 2)) 
                                           (setq pjd1n (polar pjd1 0 (/ (- kd2 kd1) 2.0)) 
                                                 pjd2n (polar pjd2 0 (/ (- kd2 kd1) 2.0)) 
                                                 pmds1n (polar pmds1 0 (- kd2 kd1)) 
                                                 pme          (polar pjd2 0 (* -0.5 kd2)) 
                                           ) 
                                           (setq pjd1n(polar pjd1(* 0.5 pi)(/(- kd2 kd1)2.0)) 
                                                 pjd2n(polar pjd2(* 0.5 pi)(/(- kd2 kd1)2.0)) 
                                                 pmds1n(polar pmds1(* 0.5 pi)(- kd2 kd1)) 
                                                 pme(polar pjd2(* 0.5 pi)(* -0.5 kd2)) 
                                           ) 
                                         ) 
                                         (if(or(>(distance2p pmds1 pmde1)(+(distance2p pmds2 pmde1)kd2)) 
                                               (equal(distance2p pmds1 pmde1) 
                                                     (+(distance2p pmds2 pmde1)kd2)5) 
                                            ) 
                                           (progn 
                                             (setq mylist (dhtss pjd1 2)) 
                                             (if (and mylist(or (= fx1 0)(= fx1 2))) 
                                               (progn 
                                                 (setq zxjn(car (XScjx))) 
                                                 (setq ysjn(last (XScjx))) 
                                                 (C_zoom mylist zxjn ysjn) 
                                                 (setq ss1(last(C_ldel mylist pjd1 kd1 sshl1))) 
                                                 (setq ss1(s2_lsx ss1)) 
                                                 (setq ss2(last(C_ldel mylist pjd2 kd2 sshl2))) 
                                                 (setq ss2(s2_lsx ss2)) 
                                                 (if(not (equal pmds1 pme 0.01)) 
                                                   (progn 
                                                     (setq smov(h_lxxz pmds1 pme fx)) 
                                                     (setq ss3(s2_ss3 pmds1 pme mylist)) 
                                                     (setq ss3(C_ssgl ss3 smov)) 
                                                     (setq ss3(s2_lsx ss3)) 
                                                     (if smove(command "_.move" smov "" pmds1 pmds1n)) 
                                                     (if ss3(command "_.move" ss3 "" pmds1 pmds1n)) 
                                                   ) 
                                                 ) 
                                                 (if sshl1(command "_.move" sshl1 "" pjd1 pjd2n)) 
                                                 (if ss1(command "_.move" ss1 "" pjd1 pjd2n)) 
                                                 (if sshl2(command "_.move" sshl2 "" pjd2 pjd1n)) 
                                                 (if ss2(command "_.move" ss2 "" pjd2 pjd1n)) 
                                                 (command "_.zoom" zxjn ysjn) 
                                               ) 
                                               (progn 
                                                 (if(not (equal pmds1 pme 0.01)) 
                                                   (progn 
                                                     (setq smov(h_lxxz pmds1 pme fx)) 
                                                     (if smov(command "_.move" smov "" pmds1 pmds1n)) 
                                                   ) 
                                                 ) 
                                                 (if sshl1(command "_.move" sshl1 "" pjd1 pjd2n)) 
                                                 (if sshl2(command "_.move" sshl2 "" pjd2 pjd1n)) 
                                               ) 
                                             ) 
                                           ) 
                                           (Xacino "回路有交叉!" "操作错误" 6) 
                                         ) 
                                        ) 
                                        ((or(and(null pmde1)(null pmde2)(equal pmds1 pmds2 0.01)) 
                                            (and pmde1(equal pmde1 pmde2 0.01) 
                                                  (equal pmds1 pmds2 0.01)) 
                                         ) 
                                         (Xacino "回路有交叉!" "操作错误" 6) 
                                        ) 
                                        ((or(and(null pmde1)(equal pmde2 pmds1 0.01)) 
                                            (and pmde1(equal pmde1 pmde2 0.01) 
                                                 (<(distance2p pmds1 pmde1) 
                                                   (distance2p pmds2 pmde2)) 
                                            ) 
                                         ) 
                                         (if(or(= fx 0)(= fx 2)) 
                                           (setq pjd1n (polar pjd1 0 (/ (- kd1 kd2) 2.0)) 
                                                 pjd2n (polar pjd2 0 (/ (- kd1 kd2) 2.0)) 
                                                 pmds1n(polar pmds1 0 (- kd1 kd2)) 
                                                 pme   (polar pjd1 0 (* -0.5 kd1)) 
                                           ) 
                                           (setq pjd1n (polar pjd1(* 0.5 pi)(/(- kd1 kd2)2.0)) 
                                                 pjd2n (polar pjd2(* 0.5 pi)(/(- kd1 kd2)2.0)) 
                                                 pmds1n(polar pmds1(* 0.5 pi)(- kd1 kd2)) 
                                                 pme         (polar pjd1(* 0.5 pi)(* -0.5 kd1)) 
                                           ) 
                                         ) 
                                         (if(or(<(+(distance2p pmds1 pmde2)kd1) 
                                                 (distance2p pmds2 pmde2)) 
                                               (equal(+ (distance2p pmds1 pmde2)kd1) 
                                                     (distance2p pmds2 pmde2)5) 
                                           ) 
                                           (progn 
                                             (setq mylist(dhtss pjd1 2)) 
                                             (if (and mylist(or (= fx1 0)(= fx1 2))) 
                                               (progn 
                                                 (setq zxjn(car (XScjx))) 
                                                 (setq ysjn(last (XScjx))) 
                                                 (C_zoom mylist zxjn ysjn) 
                                                 (setq ss1(last(C_ldel mylist pjd1 kd1 sshl1))) 
                                                 (setq ss1(s2_lsx ss1)) 
                                                 (setq ss2(last(C_ldel mylist pjd2 kd2 sshl2))) 
                                                 (setq ss2(s2_lsx ss2)) 
                                                 (if(not (equal pmds2 pme 0.01)) 
                                                   (progn 
                                                     (setq smov(h_lxxz pmds2 pme fx)) 
                                                     (setq ss3(s2_ss3 pmds2 pme mylist)) 
                                                     (setq ss3(C_ssgl ss3 smov)) 
                                                     (setq ss3(s2_lsx ss3)) 
                                                     (if smov(command "_.move" smov "" pmds1 pmds1n)) 
                                                     (if ss3(command "_.move" ss3 "" pmds1 pmds1n)) 
                                                   ) 
                                                 ) 
                                                 (if sshl1(command "_.move" sshl1 "" pjd1 pjd2n)) 
                                                 (if ss1(command "_.move" ss1 "" pjd1 pjd2n)) 
                                                 (if sshl2(command "_.move" sshl2 "" pjd2 pjd1n)) 
                                                 (if ss2(command "_.move" ss2 "" pjd2 pjd1n)) 
                                                 (command "_.zoom" zxjn ysjn) 
                                               ) 
                                               (progn 
                                                 (if(not (equal pmds2 pme 0.01)) 
                                                   (progn 
                                                     (setq smov(h_lxxz pmds2 pme fx)) 
                                                     (if smov(command "_.move" smov "" pmds1 pmds1n)) 
                                                   ) 
                                                 ) 
                                                 (if sshl1(command "_.move" sshl1 "" pjd1 pjd2n)) 
                                                 (if sshl2(command "_.move" sshl2 "" pjd2 pjd1n)) 
                                               ) 
                                             ) 
                                           ) 
                                           (Xacino "回路有交叉!" "操作错误" 6) 
                                         ) 
                                        ) 
                                        (t 
                                         (if (or (= fx 0) (= fx 2)) 
                                           (setq pjd1n (polar pjd1 0 (/ (- kd2 kd1)2.0)) 
                                                 pjd2n (polar pjd2 0 (/ (- kd1 kd2)2.0)) 
                                                 pmds1 (polar pjd1 0 (* 0.5 kd1)) 
                                                 pmds1n(polar pmds1 0(- kd2 kd1)) 
                                                 pmds2 (polar pjd2 0 (* 0.5 kd2)) 
                                                 pmds2n(polar pmds2 0(- kd1 kd2)) 
                                           ) 
                                           (setq pjd1n (polar pjd1(* 0.5 pi)(/(- kd2 kd1)2.0)) 
                                                 pjd2n (polar pjd2(* 0.5 pi)(/(- kd1 kd2)2.0)) 
                                                 pmds1 (polar pjd1(* 0.5 pi)(* 0.5 kd1)) 
                                                 pmds1n(polar pmds1(* 0.5 pi)(- kd2 kd1)) 
                                                 pmds2 (polar pjd2(* 0.5 pi)(* 0.5 kd2)) 
                                                 pmds2n(polar pmds2(* 0.5 pi)(- kd1 kd2)) 
                                           ) 
                                         ) 
                                         (setq pmde1 (h_lxdd pmds1 fx jj1)) 
                                         (setq smov1 (h_lxxz pmds1 pmde1 fx)) 
                                         (setq pmde2 (h_lxdd pmds2 fx jj1)) 
                                         (setq smov2 (h_lxxz pmds2 pmde2 fx)) 
                                         (setq list1 (dhtss pjd1 2)) 
                                         (setq list2 (dhtss pjd2 2)) 
                                         (cond 
                                           ((and(or(= fx 0)(= fx 2))list1(null list2)) 
                                            (setq zxjn(car (XScjx))) 
                                            (setq ysjn(last (XScjx))) 
                                            (C_zoom list1 zxjn ysjn) 
                                            (setq ylist1(C_xyzb list1 pjd1 kd1)) 
                                            (setq plist1(C_ldel list1 pjd1 kd1 sshl1)) 
                                            (setq xlist1(C_movt plist1 kd1 kd2 sshl2 pjd2 pjd1n smov1 1)) 
                                            (setq ess1 (last plist1)) 
                                            (if ess1(command "_.erase" ess1 "")) 
                                            (if sshl1(command        "_.move" sshl1 "" pjd1 pjd2n)) 
                                            (if smov2(command "_.move" smov2 "" pmds2 pmds2n)) 
                                            (C_slin (car xlist1) ylist1) 
                                            (C_slin (last xlist1) ylist1) 
                                            (C_hlin xlist1 ylist1 hlsm2) 
                                            (command "_.zoom" zxjn ysjn) 
                                          ) 
                                           ((and(or(= fx 0)(= fx 2))list2(null list1)) 
                                            (setq zxjn(car (XScjx))) 
                                            (setq ysjn(last (XScjx))) 
                                            (C_zoom list2 zxjn ysjn) 
                                            (setq ylist2(C_xyzb list2 pjd2 kd2)) 
                                            (setq plist2(C_ldel list2 pjd2 kd2 sshl2)) 
                                            (setq xlist2(C_movt plist2 kd2 kd1 sshl1 pjd1 pjd2n smov2 1)) 
                                            (setq ess2 (last plist2)) 
                                            (if ess2(command "_.erase" ess2 "")) 
                                            (if sshl2(command        "_.move" sshl2 "" pjd2 pjd1n)) 
                                            (if smov1(command "_.move" smov1 "" pmds1 pmds1n)) 
                                            (C_slin (car xlist2) ylist2) 
                                            (C_slin (last xlist2) ylist2) 
                                            (C_hlin xlist2 ylist2 hlsm1) 
                                            (command "_.zoom" zxjn ysjn) 
                                           ) 
                                           ((and(or(= fx 0)(= fx 2))list1 list2) 
                                            (setq zxjn(car (XScjx))) 
                                            (setq ysjn(last (XScjx))) 
                                            (C_zoom list2 zxjn ysjn) 
                                            (setq ylist2(C_xyzb list2 pjd2 kd2)) 
                                            (setq plist2(C_ldel list2 pjd2 kd2 sshl2)) 
                                            (setq xlist2(C_movt plist2 kd2 kd1 sshl1 pjd1 pjd2n smov2 1)) 
                                            (C_zoom list1 zxjn ysjn) 
                                            (setq ylist1(C_xyzb list1 pjd1 kd1)) 
                                            (setq plist1(C_ldel list1 pjd1 kd1 sshl1)) 
                                            (setq xlist1(C_movt plist1 kd1 kd2 sshl2 pjd2 pjd1n smov1 1)) 
                                            (setq ess2 (last plist2)) 
                                            (setq ess1 (last plist1)) 
                                            (if ess2(command "_.erase" ess2 "")) 
                                            (if ess1(command "_.erase" ess1 "")) 
                                            (C_slin (car xlist2) ylist2) 
                                            (C_slin (last xlist2) ylist2) 
                                            (C_hlin xlist2 ylist2 hlsm1) 
                                            (C_slin (car xlist1) ylist1) 
                                            (C_slin (last xlist1) ylist1) 
                                            (C_hlin xlist1 ylist1 hlsm2) 
                                            (command "_.zoom" zxjn ysjn) 
                                           ) 
                                           (t 
                                            (if sshl1(command "_.move" sshl1 "" pjd1 pjd2n)) 
                                            (if sshl2(command "_.move" sshl2 "" pjd2 Pjd1n)) 
                                            (if smov1(command "_.move" smov1 "" pmds1 pmds1n)) 
                                            (if smov2(command "_.move" smov2 "" pmds2 pmds2n)) 
                                           ) 
                                         ) 
                                        ) 
                                      ) 
                                    ) 
                                    (progn 
                                      (Xacino "所选回路的出线方向或间距不对,请重新选择!" "注意" 6) 
                                      (setq ttt2 nil) 
                                    ) 
                                  ) 
                                ) 
                                (setq ttt2 nil) 
                              ) 
                            ) 
                          ) 
                        ) 
                      ) 
                      (setq lll2 nil) 
                    ) 
                  ) 
                ) 
                (setq ttt1 nil) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (setq lll1 nil) 
    ) 
    (if(= lxfs 1) 
      (progn 
        (setq i 0) 
        (repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i))) 
        (setq lxfs 0) 
      ) 
    ) 
    (command "_.undo" "_end") 
    (setq fan 0) 
  ) 
) 
   
;;================================子函数结束================================== 
  (_inidwg) 
  (princ "\n*回路互换*=Hlhh") 
  (setvar "plinetype" 2) 
  (setvar "cmdecho" 0) 
  (setvar "blipmode" 0) 
  (setvar "pickadd" 1) 
  (setvar "osmode" 0) 
  (setvar "CECOLOR" "green") 
  (setq ucmark (getvar "worlducs")) 
  (if (= ucmark 0) 
    (progn 
      (setq ucs_fo (getvar "ucsfollow")) 
      (if (= ucs_fo 1)(setvar "ucsfollow" 0)) 
      (command "_.ucs" "_world") 
    ) 
  ) 
  (setq lxfs 0 tscale(atof(xrddic "Tabscale" "100")) dqw(XScjx)) 
  (setq        o_para(xgetin "Hlklib" "Hlkpara" "" 1) 
        o_mes(xgetin "Hlklib" "RetHlkMes" "" 1) 
        o_jj(xgetin "Hlklib" "Hlkjj" "30" 1) 
  ) 
  (menucmd "s=hd25l") 
  (h_sh2) 
  (if(= ucmark 0)(command "_.ucs" "_prev")) 
  (setvar "highlight" 1) 
  (setq dqwn(XScjx)) 
  (if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw))) 
  (setq *error* olderr olderr nil) 
  (_resdwg) 
  (princ) 
) 
 
;;=================================主程序开始================================= 
;;名称：C:HLINS 
;;功能：简版回路编辑-回路插入 
;;输入：无 
;;返回：无 
(defun C:HLINS(/ tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo 
                h_sh3 h_XZHL h_WZYZ h_HLHZ h_LXDD h_WZPD h_LXXZ h_mxwz h_inwi 
                h_comp C_zoom C_ssgl C_xyzb C_ldel C_movt C_movk C_hlin C_slin 
                s_px) 
  (setq olderr *error*) 
   
;;=================================子函数开始================================= 
;;名称：*error*(错误处理函数) 
;;功能：当程序发生错误或用户中断时，平静地退出，并还原状态。 
;;输入：无 
;;返回：无 
(defun *error* (msg / each) 
  (if (= fan 1)(command "_.undo" "_end")) 
  (if (= fan 1)(command "_.undo" "")) 
  (if (= ucmark 0) (command "_.ucs" "_prev")) 
  (xsetin "Hlklib" "Hlkpara" o_para 1) 
  (xsetin "Hlklib" "RetHlkMes" o_mes 1) 
  (xsetin "Hlklib" "Hlkjj" o_jj 1) 
  (if(= lxfs 1) 
    (progn(setq i 0)(repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i)))) 
  ) 
  (setq dqwn (XScjx)) 
  (if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw))) 
  (foreach each 
      '(tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo h_sh3 h_xzhl 
        h_wzyz h_hlhz h_lxdd h_wzpd h_lxxz h_mxwz h_inwi h_comp C_zoom C_ssgl C_xyzb 
        C_ldel C_movt C_movk C_hlin C_slin point1 point2 i ename point3 point4 ss 
        elist point5 point6 biao ylist plist l xlist n nylist s_px yy list1 list2 a b 
        emx p1 p2 p3 pd1 pd2 pc mxwzt wzt npd1 npd2 es sins first fxhsf hszf pmxd1 
        pmxd2 fxhs hsz wzyz ssfah fah pjd fx sshl hlsm kd hll smx mxt len1 ii iii mxmin 
        mxmax i4 pcl e pcxl pcyl pcc xzt len2 pds hljj lxl pde hs smxal ls dqw1 wzpdt 
        dist data1 data2 sm2 zdist pdmx2 mxkd lll1 ph1 ph2 ttt1 hlxzl lll2 ttt2 ph3 ph4 
        slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj jjn hldata smov zxj 
        ysj zxjn ysjn mylist ess fan name laye yanse hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 pjd2 
        fx2 kd2 hlsm2 hlxzl2 pjdn1 pjd1n pjd2n pme smov1 smov2 pmds1 pmds1n pmds2 pmds2n 
        pmde1 pmde2 jj1 jj2 sshl2 ss1 ss2 ss3 ylist1 ylist2 plist1 plist2 xlist1 xlist2 
        ess1 ess2 point shu xzb) 
      (set each nil) 
    ) 
    (setq each nil) 
    (setq *error* olderr olderr nil) 
    (_resdwg) 
    (princ) 
) 
 
;;=================================子函数开始================================= 
;;名称：C_zoom 
;;功能：判断是否zoom 
;;输入：mylist-订货图的角表 zxj-视区左下角 ysj-视区右上角 
;;返回：无 
(defun C_zoom(mylist zxjn ysjn / point1 point2) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (if(or(>(car zxjn)(car point2))(<(car ysjn)(car point1)) 
        (>(cadr zxjn)(cadr point1))(<(cadr ysjn)(cadr point2)) 
     ) 
    (command "_.ZOOM" "_w" point1 point2) 
  ) 
) 
 
;;=================================子函数开始================================= 
;;名称：C_ssgl 
;;功能：过滤选择集 
;;输入：ss1-选择集1 ss2-选择集2 
;;返回：ss1 
 (defun C_ssgl(ss1 ss2 / i ename) 
  (setq i 0) 
  (repeat(sslength ss2) 
    (setq ename (ssname ss2 i)) 
    (ssdel ename ss1) 
    (setq i (+ i 1)) 
  ) 
  ss1 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_xyzb 
;;功能：得到所选回路所有横线的Y坐标点集 
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 
;;返回：ylist-所选回路所有横线的Y坐标表 
 (defun C_xyzb(mylist pjd kd / point1 point2 point3 point4 i ss ename elist 
                                   point5 point6 biao ylist) 
  (setq ylist '()) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2))) 
  (setq point4(list(+(car point3)kd)(cadr point1)(last point1))) 
  (setq ss (ssget "W" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3)))) 
  (setq i 0) 
  (repeat (sslength ss) 
    (setq ename (ssname ss i)) 
    (setq elist (entget ename)) 
    (setq point5(cdr(assoc 10 elist))) 
    (setq point6(cdr(assoc 11 elist))) 
    (if (equal(cadr point5)(cadr point6)0.1) 
      (progn 
        (setq biao(member (cadr point5) ylist)) 
        (if (not biao) 
          (setq ylist(cons (cadr point5) ylist)) 
        ) 
      ) 
    ) 
    (setq i (+ i 1)) 
  ) 
  ylist 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_ldel 
;;功能：得到所选回路列的左上角和右下角 
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 sshl-回路选择集 
;;返回：plist-点表(所选回路列的右上角、订货图的右下角和所选回路列的选择集) 
 (defun C_ldel(mylist pjd kd sshl / point1 point2 point3 point4 point5 ss plist) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2))) 
  (setq point4(list(+(car pjd)(/ kd 2))(cadr point1)(last point2))) 
  (setq ss(ssget "w" point3 point4)) 
  (setq ss(C_ssgl ss sshl)) 
  (setq point5(list(car point4)(cadr point2)(last point2))) 
  (setq plist (list point5 point1 ss)) 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_movt 
;;功能：copy回路并移动表格(从当前图中copy或move) 
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度 
;;      sshln-替换回路 pjdf-替换回路的基点 pjd-被替回路的基点 smov-回路选择集 
;;      a-为0时拷贝,为1时移动,为2时插入 
;;返回：xlist-新回路列的x坐标 
(defun C_movt(plist kd kdn sshln pjdf pjdn smov a / point1 point2 l point3 point4 xlist ss) 
  (setq point1(car plist)) 
  (setq point2(cadr plist)) 
  (if(or(= a 0)(= a 1)) 
    (progn 
      (setq l(- kd kdn)) 
      (setq point3(list(-(car point1)l)(cadr point1)(last point1))) 
      (setq ss(ssget "w" point1 point2)) 
      (if (= a 0) 
        (command "_.copy" sshln "" pjdf pjdn) 
        (command "_.move" sshln "" pjdf pjdn) 
      ) 
      (if smov 
        (progn 
          (command "_.move" smov "" point1 point3) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point1 point3) 
      (setq xlist(list(-(car point1)kd)(car point3))) 
    ) 
    (progn 
      (setq point3(list(-(car point1)kd)(cadr point1)(last point1))) 
      (setq point4(list(+(car point3)kdn)(cadr point3)(last point3))) 
      (setq ss (ssget "w" point3 point2)) 
      (command "_.copy" sshln "" pjdf pjdn) 
      (if smov 
        (progn 
          (command "_.move" smov "" point3 point4) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point3 point4) 
      (setq xlist(list(car point3)(car point4))) 
    ) 
  ) 
  xlist 
) 
 
;;=================================子函数开始================================= 
;;名称：C_movk 
;;功能：copy回路并移动表格(从图库中取) 
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度 
;;      pjdn-替换回路 fx-回路方向 dist、data1、data2、sm2-调回路库的参数 smov-回路选择集 
;;      a-为时替换回路,为2时插入回路 
;;返回：xlist-新回路列的两个x坐标 
(defun C_movk(plist kd kdn pjdn fx dist data1 data2 sm2 smov a / point1 point2 l point3 
              point4 xlist ss) 
  (setq point1(car plist)) 
  (setq point2(cadr plist)) 
  (if (= a 1) 
    (progn 
      (setq l(- kd kdn)) 
      (setq point3(list(-(car point1)l)(cadr point1)(last point1))) 
      (setq ss(ssget "w" point1 point2)) 
      (h_hlhz pjdn fx dist data1 data2 sm2) 
      (if smov 
        (progn 
          (command "_.move" smov "" point1 point3) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point1 point3) 
      (setq xlist(list(-(car point1)kd)(car point3))) 
    ) 
    (progn 
      (setq point3(list(-(car point1)kd)(cadr point1)(last point1))) 
      (setq point4(list(+(car point3)kdn)(cadr point3)(last point3))) 
      (setq ss (ssget "w" point3 point2)) 
      (h_hlhz pjdn fx dist data1 data2 sm2) 
      (if smov 
        (progn 
          (command "_.move" smov "" point3 point4) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point3 point4) 
      (setq xlist(list(car point3)(car point4))) 
    ) 
  ) 
  xlist 
) 
 
;;=================================子函数开始================================= 
;;名称：C_hlin 
;;功能：画横线 
;;输入：xlist-新订货图的x坐标表 ylist-所选订货图所有横线的Y坐标表 hlsm-回路数目 
;;返回：无 
(defun C_hlin(xlist ylist hlsm / point1 point2 i l n) 
  (setq i 0) 
  (setq l(/(abs(-(car xlist)(last xlist)))hlsm)) 
  (repeat (length ylist) 
    (setq n 0) 
    (repeat hlsm 
      (setq point1(list(+(car xlist)(* l n))(nth i ylist)0.0)) 
      (setq point2(list(+(car xlist)(* l (+ n 1)))(nth i ylist)0.0)) 
      (command "_.line" point1 point2 "") 
      (setq n (+ n 1)) 
    ) 
    (setq i (+ i 1)) 
  ) 
) 
 
;;=================================子函数开始================================= 
;;名称：s_px 
;;功能：排序(从大到小) 
;;输入：ylist-所选订货图所有横线的Y坐标表 
;;返回：nylist 
  (defun s_px(ylist / i nylist yy list1 list2) 
    (setq nylist '()) 
    (while (/= (length ylist) 0) 
      (setq i 1) 
      (setq yy (nth 0 ylist)) 
      (repeat (-(length ylist)1) 
        (if (> yy (nth i ylist)) 
          (setq yy (nth i ylist)) 
        ) 
        (setq i (+ i 1)) 
      ) 
      (setq nylist (cons yy nylist)) 
      (setq list1 (cdr (member yy ylist))) 
      (setq list2 (cdr (member yy (reverse ylist)))) 
      (setq ylist (append list1 list2)) 
    ) 
    nylist 
  ) 
 
;;=================================子函数开始================================= 
;;名称：C_slin 
;;功能：画竖线 
;;输入：xzb-x坐标 ylist-所选订货图所有横线的Y坐标表 
;;返回：无 
 (defun C_slin(xzb ylist / nylist point1 point2 i) 
  (setq i 0) 
  (setq nylist(s_px ylist)) 
  (repeat (-(length nylist)1) 
    (setq point1(list xzb (nth i nylist))) 
    (setq point2(list xzb (nth (+ i 1) nylist))) 
    (command "_.line" point1 point2 "") 
    (setq i (+ i 1)) 
  ) 
 ) 
   
;;=================================子函数开始================================= 
;;名称：h_comp 
;;功能：计算两值的差(用于排序) 
;;输入：a、b 
;;返回：两值的差 
  (defun h_comp (a b) 
    (- a b) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_inwi 
;;功能: 判断p1是否在p2 p3组成的窗口内 
;;输入: p1 p2 p3 
;;返回: 0-在窗口内、1-在窗口外、nil-边界上 
  (defun h_inwi (p1 p2 p3) 
    (cond 
      ((and(< (car p1) (- (max (car p2) (car p3)) tscale)) 
            (> (car p1) (+ (min (car p2) (car p3)) tscale)) 
            (< (cadr p1) (- (max (cadr p2) (cadr p3)) tscale)) 
            (> (cadr p1) (+ (min (cadr p2) (cadr p3)) tscale)) 
        ) 
        0 
      ) 
      ((or(> (car p1) (+ (max (car p2) (car p3)) tscale)) 
           (< (car p1) (- (min (car p2) (car p3)) tscale)) 
           (> (cadr p1) (+ (max (cadr p2) (cadr p3)) tscale)) 
           (< (cadr p1) (- (min (cadr p2) (cadr p3)) tscale)) 
        ) 
        1 
      ) 
      (t nil) 
    ) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_mxwz 
;;功能: 母线位置判断 
;;输入: emx p1 p2 
;;返回: mxwzt 
  (defun h_mxwz        (emx p1 p2 / pd1 pd2 pc mxwzt) 
    (setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
          pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
    ) 
    (setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0))) 
    (if        (or (> (car pc) (max (car p1) (car p2))) 
            (> (cadr pc) (max (cadr p1) (cadr p2))) 
            (< (car pc) (min (car p1) (car p2))) 
            (< (cadr pc) (min (cadr p1) (cadr p2))) 
        ) 
      (setq mxwzt nil) 
      (setq mxwzt pc) 
    ) 
    mxwzt 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_wzpd 
;;功能: 位置判断、判断实体（块-插入点，线-二端点）是否在窗口之内 
;;输入: 实体名 窗口二角点 
;;返回: 在窗口内-中点 
;;      不在窗口内-T 
;;      交叉(线)-nil 
  (defun h_wzpd (emx p1 p2 ss / pd1 pd2 pc wzt npd1 npd2 es sins i) 
    (cond 
      ((= (cdr (assoc 0 (entget emx))) "LWPOLYLINE") 
       (setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
             pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
       ) 
       (setq pc        (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0))) 
       (setq npd1 (h_inwi pd1 p1 p2) 
             npd2 (h_inwi pd2 p1 p2) 
       ) 
       (cond 
        ((or(and (= npd1 0) (= npd2 1))(and (= npd2 0) (= npd1 1))) 
         (setq wzt nil) 
        ) 
         ((or (= npd1 1) (= npd2 1)) 
          (setq wzt t) 
         ) 
         (t (setq wzt pc)) 
       ) 
      ) 
      (t 
       (setq pc (cdr (assoc 10 (entget emx)))) 
       (cond 
        ((= (h_inwi pc p1 p2) 1) 
          (setq wzt t) 
         ) 
         ((null (h_inwi pc p1 p2)) 
          (if (= (cdr (assoc 0 (entget emx))) "insert") 
            (progn 
              (setq        sins (ssget "c" 
                                    (polar pc (* 0.25 pi) tscale) 
                                    (polar pc (* 0.25 pi) tscale) 
                                    '((0 . "insert,lwpolyline")) 
                             ) 
                  ) 
                  (setq        wzt pc 
                        i   0 
                  ) 
                  (while (and wzt (
                    (setq es (ssname sins i)) 
                    (if        (not (ssmemb es sins)) 
                      (setq wzt t) 
                      (setq i (1+ i)) 
                    ) 
                  ) 
                ) 
                (setq wzt pc) 
              ) 
             ) 
             (t (setq wzt pc)) 
       ) 
      ) 
    ) 
    wzt 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_wzyz 
;;功能: 母线位置一致性判断 
;;输入: 母线 循环号 (方向初值 坐标初值) 
;;返回: i=0 (方向 坐标) 
;;      i/=0 位置一致 t 
;;           位置不一致 nil 
  (defun h_wzyz        (emx i first / fxhsf hszf pmxd1 pmxd2 fxhs hsz wzyz) 
    (setq fxhsf        (car first) 
          hszf        (cadr first) 
    ) 
    (setq pmxd1        (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
          pmxd2        (append        (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
    ) 
    (if(equal (car pmxd1) (car pmxd2) 0.001) 
      (setq fxhs 1 hsz (car pmxd1)) 
      (setq fxhs 0 hsz (cadr pmxd1)) 
    ) 
    (if(= i 0) 
      (setq wzyz (list fxhs hsz)) 
      (progn 
        (if (or(not (equal fxhs fxhsf 0.01)) 
                (not (equal hsz hszf 0.01)) 
            ) 
         (setq wzyz nil) 
          (setq wzyz t) 
        ) 
      ) 
    ) 
    wzyz 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_xzhl 
;;功能: 选择回路 
;;输入: 窗口二角点p1，p2 
;;返回: t-(基点 方向? 宽度 回路选择集 回路数) 方向--0 向下 1 向右 2 向上 3 向左 
;;       NIL-nil 
  (defun h_xzhl        (p1    p2    /           ssfah fah   pjd   fx           sshl         hlsm 
                 kd    hll   smx   i         mxt   fxhs  hsz   len1         ii 
                 emx   iii   pd1   pd2         mxmin mxmax p1           p2         pc 
                 ss    i4    pcl   first e     pcxl  pcyl  pcc   xzt 
                 len2 
                ) 
    (setq hll nil) 
    (setq smx (ssget "c" p1 p2 '((0 . "lwpolyline") (8 . "mx")))) 
    (if        smx 
      (progn 
        (setq i        0 mxt t) 
        (while (and mxt (
          (setq emx (ssname smx i)) 
          (if (= i 0) 
            (setq first (h_wzyz emx 0 nil)) 
            (setq mxt (h_wzyz emx i first)) 
          ) 
          (setq i (1+ i)) 
        )                                ;判断母线位置一致性 
        (if mxt 
          (progn 
            (setq fxhs (car first) 
                  hsz  (cadr first) 
                  ii   0 
                  len1 (sslength smx) 
            ) 
            (repeat len1 
              (setq emx (ssname smx ii)) 
              (if (h_mxwz emx p1 p2) 
                (setq ii (1+ ii)) 
                (ssdel emx smx) 
              ) 
            )                                ;删除中心在边界外的母线 
            (setq hlsm (sslength smx)) 
            (if        (/= hlsm 0) 
              (progn 
                (setq iii 0) 
                (repeat        hlsm 
                  (setq emx (ssname smx iii)) 
                  (setq        pd1 (cdr (assoc 10 (entget emx))) 
                        pd2 (cdr (assoc 10 (reverse (entget emx)))) 
                  ) 
                  (if (= fxhs 0) 
                    (if        (= iii 0) 
                      (setq mxmin (min (car pd1) (car pd2)) 
                            mxmax (max (car pd1) (car pd2)) 
                      ) 
                      (progn 
                        (if (< (min (car pd1) (car pd2)) mxmin) 
                          (setq mxmin (min (car pd1) (car pd2))) 
                        ) 
                        (if (> (max (car pd1) (car pd2)) mxmax) 
                          (setq mxmax (max (car pd1) (car pd2))) 
                        ) 
                      ) 
                    ) 
                    (if        (= iii 0) 
                      (setq mxmin (min (cadr pd1) (cadr pd2)) 
                            mxmax (max (cadr pd1) (cadr pd2)) 
                      ) 
                      (progn 
                        (if (< (min (cadr pd1) (cadr pd2)) mxmin) 
                          (setq mxmin (min (cadr pd1) (cadr pd2))) 
                        ) 
                        (if (> (max (cadr pd1) (cadr pd2)) mxmax) 
                          (setq mxmax (max (cadr pd1) (cadr pd2))) 
                        ) 
                      ) 
                    ) 
                  ) 
                  (setq iii (1+ iii)) 
                ) 
                (setq kd (- mxmax mxmin)) 
                (if (= fxhs 0) 
                  (setq        p1  (list mxmin (cadr p1) 0.0) 
                        p2  (list mxmax (cadr p2) 0.0) 
                        pjd (list (/ (+ mxmin mxmax) 2) hsz 0.0) 
                  ) 
                  (setq        p1  (list (car p1) mxmin 0.0) 
                        p2  (list (car p2) mxmax 0.0) 
                        pjd (list hsz (/ (+ mxmin mxmax) 2) 0.0) 
                  ) 
                )                        ;取得母线范围并更新选择集窗口 
 
                (setq ss (ssget "c" p1 p2 '((8 . "mx,fah,bxt,xhgg,xmdh")))) 
                (setq i4   0 
                      pcl  nil 
                      len2 (sslength ss) 
                      xzt  t 
                ) 
                (while (and xzt (< i4 len2)) 
                  (setq e (ssname ss i4)) 
                  (if (setq pc (h_wzpd e p1 p2 smx)) 
                    (progn 
                      (if (= pc t) 
                        (progn 
                          (ssdel e ss) 
                          (setq len2 (1- len2)) 
                        ) 
                        (progn 
                          (setq pcl (cons pc pcl)) 
                          (setq i4 (1+ i4)) 
                        ) 
                      ) 
                    ) 
                    (setq xzt nil) 
                  ) 
                ) 
                                        ;去掉多余实体,如果交叉结束 
                (if xzt 
                  (progn 
                    (setq pcxl (mapcar 'car pcl) 
                          pcyl (mapcar 'cadr pcl) 
                    ) 
                    (setq pcc (list (/ (apply '+ pcxl) (length pcl)) 
                                    (/ (apply '+ pcyl) (length pcl)) 
                                    0.0 
                              ) 
                    ) 
                    (if        (= fxhs 0) 
                      (if (< (cadr pcc) (cadr pjd)) 
                        (setq fx 0) 
                        (setq fx 2) 
                      ) 
                      (if (> (car pcc) (car pjd)) 
                        (setq fx 1) 
                        (setq fx 3) 
                      ) 
                    ) 
                    (setq hll (list pjd fx kd ss hlsm)) 
                  ) 
                  (Xacino "回路选择不完整!" "操作错误" 6) 
                ) 
              ) 
            ) 
          ) 
          (Xacino "选了其他回路的母线!" "操作错误" 6) 
        ) 
      ) 
    ) 
    hll 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_lxdd 
;;功能: 连续母线端点 
;;输入: 端点 方向 
;;返回: 下一端点 
  (defun h_lxdd        (pds fx hljj / p1 p2 lxl pde e hs smxal) 
    (setq pde nil) 
    (setq smxal (ssget "x" '((8 . "mx")))) 
    (if(or (= fx 0) (= fx 2)) 
      (setq lxl (list (car pds))) 
      (setq lxl (list (cadr pds))) 
    ) 
    (while (setq e (ssname smxal 0)) 
      (setq p1 (cdr (assoc 10 (entget e))) 
            p2 (cdr (assoc 10 (reverse (entget e)))) 
      ) 
      (if (or (= fx 0) (= fx 2)) 
        (if (and (equal (cadr p1) (cadr pds) 0.001) 
                 (equal (cadr p2) (cadr pds) 0.001) 
            ) 
          (if (> (setq hs (max (car p1) (car p2))) (car pds)) 
            (setq lxl (cons hs lxl)) 
          ) 
        ) 
        (if (and (equal (car p1) (car pds) 0.001) 
                 (equal (car p2) (car pds) 0.001) 
            ) 
          (if (> (setq hs (max (cadr p1) (cadr p2))) (cadr pds)) 
            (setq lxl (cons hs lxl)) 
          ) 
        ) 
      ) 
      (ssdel e smxal) 
    ) 
    (if(> (length lxl) 1) 
      (setq lxl (qsort h_comp lxl)) 
    ) 
    (while (and        (> (length lxl) 1) 
                (< (- (cadr lxl) (car lxl)) (* 1.5 hljj)) 
           ) 
      (setq lxl (cdr lxl)) 
      (if (or (= fx 0) (= fx 2)) 
        (setq pde (list(car lxl)(cadr pds)        0.0)) 
        (setq pde (list(car pds)(car lxl)        0.0)) 
      ) 
    ) 
    pde 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_lxxz 
;;功能: 连续回路选择,选择由一点开始的所有连续同方向回路 
;;输入: 开始点 结束点 方向 
;;返回: 选择集 
  (defun h_lxxz        (pds pde fx / p1 p2 ss i ls emx dqw1 wzpdt) 
    (setq ss nil) 
    (if        (and pds pde) 
      (progn 
        (cond 
          ((= fx 0) 
           (setq p1 (polar pds (* 1.5 pi) (* 90 tscale)) 
                 p2 (polar pde (* 0.5 pi) (* 2 tscale)) 
           ) 
          ) 
          ((= fx 1) 
           (setq p1 (polar pds pi (* 2 tscale)) 
                 p2 (polar pde 0 (* 90 tscale)) 
           ) 
          ) 
          ((= fx 2) 
           (setq p1 (polar pds (* 1.5 pi) (* 2 tscale)) 
                 p2 (polar pde (* 0.5 pi) (* 90 tscale)) 
           ) 
          ) 
          ((= fx 3) 
           (setq p1 (polar pds pi (* 90 tscale)) 
                 p2 (polar pde 0 (* 2 tscale)) 
           ) 
          ) 
        ) 
        (setq dqw1 (XScjx)) 
        (if (or        (= (h_inwi p1 (car dqw1) (cadr dqw1)) 1) 
                (= (h_inwi p2 (car dqw1) (cadr dqw1)) 1) 
            ) 
          (progn 
            (command "_.zoom" 
                     (list (min (car p1) (caar dqw1)) 
                           (min (cadr p1) (cadar dqw1)) 
                     ) 
                     (list (max (car p2) (caadr dqw1)) 
                           (max (cadr p2) (cadadr dqw1)) 
                     ) 
            ) 
          ) 
        ) 
        (setq ss (ssget "c" p1 p2 '((8 . "mx,bxt,fah,xhgg,xmdh")))) 
 
        (setq i         0 
              ls (sslength ss) 
        ) 
        (repeat        ls 
          (setq emx (ssname ss i)) 
          (setq wzpdt (h_wzpd emx p1 p2 ss)) 
          (if (or (null wzpdt) (= wzpdt t)) 
            (ssdel emx ss) 
            (setq i (1+ i)) 
          ) 
        ) 
      ) 
    ) 
    ss 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_hlhz 
;;功能: 回路绘制 
;;输入: 回路起始点 方向 回路间距 
;;返回: 无 
  (defun h_hlhz(pjd fx dist data1 data2 sm2 / zdist pds pdmx2 pdmx1 mxkd shu) 
    (setq zdist (* sm2 dist)) 
    (Xsetin "Hlklib" "Hlkjj" (rtos (/ dist tscale) 2 2) 1) 
    (shldy pjd fx data1 data2)                ;回路绘制 
    (command "_.color" "_green") 
    (command "_.Layer" "_m" "mx" "_c" 3 "" "") 
    (if        (or (= fx 0) (= fx 2)) 
      (setq pds (polar pjd 0 (* -0.5 zdist))) 
      (setq pds (polar pjd (* 0.5 pi) (* -0.5 zdist))) 
    ) 
    (setq pdmx1 pds) 
    (repeat sm2 
      (if (or (= fx 0) (= fx 2)) 
        (setq pdmx2 (polar pdmx1 0 dist)) 
        (setq pdmx2 (polar pdmx1 (* 0.5 pi) dist)) 
      ) 
      (setq mxkd (atof (Xgetin "Hlklib" "Hlkmx" "0.6" 1))) 
      (setq mxkd (* mxkd tscale)) 
      (command "_.pline" pdmx1 "_w" mxkd "" pdmx2 "") 
      (setq pdmx1 pdmx2) 
    )                                        ;母线绘制 
    (setq shu(tblsearch "layer""GDXT")) 
    (if shu(command "_.layer" "_set" "GDXT" "")) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_sh3 
;;功能: 回路插入 
;;输入: 无 
;;返回: 无 
(defun h_sh3(/ lll1 ph1        ph2 ttt1 hlxzl pjd fx kd sshl hlsm lll2 ttt2 ph3 ph4 
               lxfs slx        pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde 
               jj jjn sshl hldata i data1 data2 dist sm2 smov zxj ysj zxjn ysjn 
               mylist ylist plist xlist fan shu) 
  (setq zxj(car(XScjx))) 
  (setq ysj(last(XScjx))) 
  (setq lll1 t) 
  (while lll1 
    (command "_.undo" "_group") 
    (setq shu(tblsearch "layer""GDXT")) 
    (if shu(command "_.layer" "_set" "GDXT" "")) 
    (setq fan 1) 
    (prompt"\n请用窗口(W)选择回路(在所选回路的左边或下边插入):") 
    (setq ph1 1) 
    (while(not(listp ph1)) 
      (initget 128) 
      (setq ph1 (getpoint "\n请输入窗口第一点<回车结束>:")) 
    ) 
    (if ph1 
      (progn 
        (setq ttt1 t) 
        (while ttt1 
          (setq ph2 1) 
          (while(not(listp ph2)) 
            (initget 128) 
            (setq ph2 (getcorner ph1 "\n请输入窗口第二点:")) 
          ) 
          (if ph2 
            (progn 
              (setq hlxzl (h_xzhl ph1 ph2)) 
              (if hlxzl 
                (progn 
                  (setq ttt1 nil i 0) 
                  (setq pjd  (nth 0 hlxzl) 
                        fx   (nth 1 hlxzl) 
                        kd   (nth 2 hlxzl) 
                        sshl (nth 3 hlxzl) 
                        hlsm (nth 4 hlxzl) 
                  ) 
                  (repeat(sslength sshl)(redraw(ssname sshl i)3)(setq i(1+ i))) 
                  (setq lxfs 1 slx  sshl) 
                  (if(=(IfWndVis "hlklibclass") 0) 
                    (hlklib 0 1 "s" 0 1 1 0 0) 
                    (progn 
                      (xsetin "Hlklib" "Hlkpara" "0&1&0&1&1&0&0" 1) 
                      (xsetin "Hlklib" "RetHlkMes" "s" 1) 
                    ) 
                  ) 
                  (setq lll2 t) 
                  (while lll2 
                    (prompt "\n请用窗口(W)或从图库选择插入回路:") 
                    (setq ph3 1) 
                    (while(and(/= ph3 "s")(not(listp ph3))) 
                      (initget 128 "s") 
                      (setq ph3(getpoint"\n请输入窗口第一点或请选取方案<回车结束>:")) 
                    ) 
                    (cond 
                      ((and ph3 (listp ph3)) 
                       (setq ttt2 t) 
                       (while        ttt2 
                         (setq ph4 1) 
                         (while(not(listp ph4)) 
                           (initget 128) 
                           (setq ph4 (getcorner ph3 "\n请输入窗口第二点:")) 
                         ) 
                         (if ph4 
                           (progn 
                             (setq hlxzln (h_xzhl ph3 ph4)) 
                             (if hlxzln 
                               (progn 
                                 (setq pjdf(nth 0 hlxzln) fxn(nth 1 hlxzln) kdn(nth 2 hlxzln) 
                                       sshln(nth 3 hlxzln) hlsmn(nth 4 hlxzln)) 
                                 (setq jj(/ kd hlsm) jjn(/ kdn hlsmn)) 
                                 (if(and(equal jj jjn 0.01)(= fx fxn)) 
                                   (progn 
                                     (setq ttt2 nil lll2 nil) 
                                     (if(or(= fx 0)(= fx 2)) 
                                       (setq pjdn(polar pjd 0(/(- kdn kd)2.0)) 
                                             pmds(polar pjd 0(/ kd -2.0)) 
                                             pmdsn(polar pmds 0 kdn) 
                                       ) 
                                       (setq pjdn(polar pjd (* 0.5 pi)(/(- kdn kd)2.0)) 
                                             pmds(polar pjd(* 0.5 pi)(/ kd -2.0)) 
                                             pmdsn(polar pmds(* 0.5 pi) kdn) 
                                       ) 
                                     ) 
                                     (setq pmde (h_lxdd pmds fx jj)) 
                                     (setq smov (h_lxxz pmds pmde fx)) 
                                     (setq mylist(dhtss pjd 2)) 
                                     (if(and mylist(or(= fx 0)(= fx 2))) 
                                       (progn 
                                         (setq zxjn(car(XScjx))) 
                                         (setq ysjn(last(XScjx))) 
                                         (C_zoom mylist zxjn ysjn) 
                                         (setq ylist(C_xyzb mylist pjd kd)) 
                                         (setq plist(C_ldel mylist pjd kd sshl)) 
                                         (setq xlist(C_movt plist kd kdn sshln pjdf pjdn smov 2)) 
                                         (C_slin (car xlist) ylist) 
                                         (C_hlin xlist ylist hlsmn) 
                                         (command "_.zoom" zxj ysj) 
                                       ) 
                                       (progn 
                                         (command "_.copy" sshln "" pjdf pjdn) 
                                         (if smov(command "_.move" smov "" pmds pmdsn)) 
                                       ) 
                                     ) 
                                   ) 
                                   (progn 
                                     (Xacino "所选回路的出线方向或间距不对,请重新选择!" "注意" 6) 
                                     (setq ttt2 nil) 
                                   ) 
                                 ) 
                               ) 
                               (setq ttt2 nil) 
                             ) 
                           ) 
                         ) 
                       ) 
                      ) 
                      ((= ph3 "s") 
                       (setq lll2 nil) 
                       (setq hldata (xgetin "Hlklib" "Hlkdata" "" 1)) 
                       (setq data1(_getnS hldata 1 "&") data2(_getnS hldata 2 "&")) 
                       (setq dist (/ kd hlsm)) 
                       (setq sm2 (fhlnum data1 data2)) 
                       (setq kdn (* sm2 dist)) 
                       (if (or (= fx 0) (= fx 2)) 
                         (setq pjdn  (polar pjd 0 (/ (- kdn kd) 2.0)) 
                               pmds  (polar pjd 0 (/ kd -2.0)) 
                               pmdsn (polar pmds 0 kdn) 
                         ) 
                         (setq pjdn  (polar pjd (* 0.5 pi) (/ (- kdn kd) 2.0)) 
                               pmds  (polar pjd (* 0.5 pi) (/ kd -2.0)) 
                               pmdsn (polar pmds (* 0.5 pi) kdn) 
                         ) 
                       ) 
                       (setq pmde (h_lxdd pmds fx dist)) 
                       (setq smov (h_lxxz pmds pmde fx)) 
                       (setq mylist(dhtss pjd 2)) 
                       (if(and mylist (or (= fx 0) (= fx 2))) 
                         (progn 
                           (setq zxjn(car(XScjx))) 
                           (setq ysjn(last(XScjx))) 
                           (C_zoom mylist zxjn ysjn) 
                           (setq ylist(C_xyzb mylist pjd kd)) 
                           (setq plist(C_ldel mylist pjd kd sshl)) 
                           (setq xlist(C_movk plist kd kdn pjdn fx dist        data1 data2 sm2 smov 2)) 
                           (C_slin (car xlist) ylist) 
                           (C_hlin xlist ylist sm2) 
                           (command "_.zoom" zxj ysj) 
                         ) 
                         (progn 
                           (if smov (command "_.move" smov "" pmds pmdsn)) 
                           (h_hlhz pjdn fx dist data1 data2 sm2) 
                         ) 
                       ) 
                      ) 
                      (t (setq lll2 nil)) ;回车返回 
                    ) 
                  )                        ;替换选取循环 
                ) 
                (setq ttt1 nil) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (setq lll1 nil) 
    )                                 ;是否ph1--t 
    (if(= lxfs 1) 
      (progn 
        (setq i 0) 
        (repeat (sslength slx) 
          (redraw (ssname slx i) 4) 
          (setq i (1+ i)) 
        ) 
        (setq lxfs 0) 
      ) 
    ) 
    (command "_.undo" "_end") 
    (setq fan 0) 
  )                                        ;被替换选取循环 
) 
   
;;================================子函数结束================================== 
  (_inidwg) 
  (princ "\n*回路插入*=Hlins") 
  (setvar "plinetype" 2) 
  (setvar "cmdecho" 0) 
  (setvar "blipmode" 0) 
  (setvar "pickadd" 1) 
  (setvar "osmode" 0) 
  (setvar "CECOLOR" "green") 
  (setq ucmark (getvar "worlducs")) 
  (if (= ucmark 0) 
    (progn 
      (setq ucs_fo (getvar "ucsfollow")) 
      (if (= ucs_fo 1)(setvar "ucsfollow" 0)) 
      (command "_.ucs" "_world") 
    ) 
  ) 
  (setq lxfs 0 tscale(atof(xrddic "Tabscale" "100")) dqw(XScjx)) 
  (setq        o_para(xgetin "Hlklib" "Hlkpara" "" 1) 
        o_mes(xgetin "Hlklib" "RetHlkMes" "" 1) 
        o_jj(xgetin "Hlklib" "Hlkjj" "30" 1) 
  ) 
  (menucmd "s=hd25l") 
  (h_sh3) 
  (if(= ucmark 0)(command "_.ucs" "_prev")) 
  (setvar "highlight" 1) 
  (setq dqwn(XScjx)) 
  (if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw))) 
  (setq *error* olderr olderr nil) 
  (_resdwg) 
  (princ) 
) 
 
;;=================================主程序开始================================= 
;;名称：C:HLDEL 
;;功能：简版回路编辑-回路删除 
;;输入：无 
;;返回：无 
(defun C:HLDEL(/ tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo 
                h_sh4 h_XZHL h_WZYZ h_HLHZ h_LXDD h_WZPD h_LXXZ h_mxwz h_inwi 
                h_comp C_zoom C_ssgl C_xyzb C_ldel C_movt C_movk C_hlin C_slin 
                s_px) 
  (setq olderr *error*) 
   
;;=================================子函数开始================================= 
;;名称：*error*(错误处理函数) 
;;功能：当程序发生错误或用户中断时，平静地退出，并还原状态。 
;;输入：无 
;;返回：无 
(defun *error* (msg / each) 
  (if (= fan 1)(command "_.undo" "_end")) 
  (if (= fan 1)(command "_.undo" "")) 
  (if (= ucmark 0) (command "_.ucs" "_prev")) 
  (xsetin "Hlklib" "Hlkpara" o_para 1) 
  (xsetin "Hlklib" "RetHlkMes" o_mes 1) 
  (xsetin "Hlklib" "Hlkjj" o_jj 1) 
  (if(= lxfs 1) 
    (progn(setq i 0)(repeat(sslength slx)(redraw(ssname slx i)4)(setq i(1+ i)))) 
  ) 
  (setq dqwn (XScjx)) 
  (if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw))) 
  (foreach each 
      '(tscale lxfs dqw dqwn o_para o_mes o_jj kword ucmark ucs_fo h_sh4 h_xzhl 
        h_wzyz h_hlhz h_lxdd h_wzpd h_lxxz h_mxwz h_inwi h_comp C_zoom C_ssgl C_xyzb 
        C_ldel C_movt C_movk C_hlin C_slin point1 point2 i ename point3 point4 ss 
        elist point5 point6 biao ylist plist l xlist n nylist s_px yy list1 list2 a b 
        emx p1 p2 p3 pd1 pd2 pc mxwzt wzt npd1 npd2 es sins first fxhsf hszf pmxd1 
        pmxd2 fxhs hsz wzyz ssfah fah pjd fx sshl hlsm kd hll smx mxt len1 ii iii mxmin 
        mxmax i4 pcl e pcxl pcyl pcc xzt len2 pds hljj lxl pde hs smxal ls dqw1 wzpdt 
        dist data1 data2 sm2 zdist pdmx2 mxkd lll1 ph1 ph2 ttt1 hlxzl lll2 ttt2 ph3 ph4 
        slx pjdf pjdn fxn kdn sshln hlsmn hlxzln pmds pmdsn pmde jj jjn hldata smov zxj 
        ysj zxjn ysjn mylist ess fan name laye yanse hlxzl1 pjd1 fx1 kd1 sshl1 hlsm1 pjd2 
        fx2 kd2 hlsm2 hlxzl2 pjdn1 pjd1n pjd2n pme smov1 smov2 pmds1 pmds1n pmds2 pmds2n 
        pmde1 pmde2 jj1 jj2 sshl2 ss1 ss2 ss3 ylist1 ylist2 plist1 plist2 xlist1 xlist2 
        ess1 ess2 point s4_xc s4_glx shu xzb) 
      (set each nil) 
    ) 
    (setq each nil) 
    (setq *error* olderr olderr nil) 
    (_resdwg) 
    (princ) 
) 
 
;;=================================子函数开始================================= 
;;名称：C_zoom 
;;功能：判断是否zoom 
;;输入：mylist-订货图的角表 zxj-视区左下角 ysj-视区右上角 
;;返回：无 
(defun C_zoom(mylist zxjn ysjn / point1 point2) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (if(or(>(car zxjn)(car point2))(<(car ysjn)(car point1)) 
        (>(cadr zxjn)(cadr point1))(<(cadr ysjn)(cadr point2)) 
     ) 
    (command "_.ZOOM" "_w" point1 point2) 
  ) 
) 
 
;;=================================子函数开始================================= 
;;名称：C_ssgl 
;;功能：过滤选择集 
;;输入：ss1-选择集1 ss2-选择集2 
;;返回：ss1 
 (defun C_ssgl(ss1 ss2 / i ename) 
  (setq i 0) 
  (repeat(sslength ss2) 
    (setq ename (ssname ss2 i)) 
    (ssdel ename ss1) 
    (setq i (+ i 1)) 
  ) 
  ss1 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_xyzb 
;;功能：得到所选回路所有横线的Y坐标点集 
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 
;;返回：ylist-所选回路所有横线的Y坐标表 
 (defun C_xyzb(mylist pjd kd / point1 point2 point3 point4 i ss ename elist 
                                   point5 point6 biao ylist) 
  (setq ylist '()) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2))) 
  (setq point4(list(+(car point3)kd)(cadr point1)(last point1))) 
  (setq ss (ssget "C" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3)))) 
  (setq i 0) 
  (repeat (sslength ss) 
    (setq ename (ssname ss i)) 
    (setq elist (entget ename)) 
    (setq point5(cdr(assoc 10 elist))) 
    (setq point6(cdr(assoc 11 elist))) 
    (if (equal(cadr point5)(cadr point6)0.1) 
      (progn 
        (setq biao(member (cadr point5) ylist)) 
        (if (not biao) 
          (setq ylist(cons (cadr point5) ylist)) 
        ) 
      ) 
    ) 
    (setq i (+ i 1)) 
  ) 
  ylist 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_ldel 
;;功能：得到所选回路列的左上角和右下角 
;;输入：mylist-订货图的角表 pjd-母线基点 kd-母线长 sshl-回路选择集 
;;返回：plist-点表(所选回路列的右上角、订货图的右下角和所选回路列的选择集) 
 (defun C_ldel(mylist pjd kd sshl / point1 point2 point3 point4 point5 ss plist) 
  (setq point1(car mylist)) 
  (setq point2(last mylist)) 
  (setq point3(list(-(car pjd)(/ kd 2))(cadr point2)(last point2))) 
  (setq point4(list(+(car pjd)(/ kd 2))(cadr point1)(last point2))) 
  (setq ss(ssget "w" point3 point4)) 
  (setq ss(C_ssgl ss sshl)) 
  (setq point5(list(car point4)(cadr point2)(last point2))) 
  (setq plist (list point5 point1 ss)) 
 ) 
 
;;=================================子函数开始================================= 
;;名称：C_movt 
;;功能：copy回路并移动表格(从当前图中copy或move) 
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度 
;;      sshln-替换回路 pjdf-替换回路的基点 pjd-被替回路的基点 smov-回路选择集 
;;      a-为0时拷贝,为1时移动,为2时插入 
;;返回：xlist-新回路列的x坐标 
(defun C_movt(plist kd kdn sshln pjdf pjdn smov a / point1 point2 l point3 point4 xlist ss) 
  (setq point1(car plist)) 
  (setq point2(cadr plist)) 
  (if(or(= a 0)(= a 1)) 
    (progn 
      (setq l(- kd kdn)) 
      (setq point3(list(-(car point1)l)(cadr point1)(last point1))) 
      (setq ss(ssget "w" point1 point2)) 
      (if (= a 0) 
        (command "_.copy" sshln "" pjdf pjdn) 
        (command "_.move" sshln "" pjdf pjdn) 
      ) 
      (if smov 
        (progn 
          (command "_.move" smov "" point1 point3) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point1 point3) 
      (setq xlist(list(-(car point1)kd)(car point3))) 
    ) 
    (progn 
      (setq point3(list(-(car point1)kd)(cadr point1)(last point1))) 
      (setq point4(list(+(car point3)kdn)(cadr point3)(last point3))) 
      (setq ss (ssget "w" point3 point2)) 
      (command "_.copy" sshln "" pjdf pjdn) 
      (if smov 
        (progn 
          (command "_.move" smov "" point3 point4) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point3 point4) 
      (setq xlist(list(car point3)(car point4))) 
    ) 
  ) 
  xlist 
) 
 
;;=================================子函数开始================================= 
;;名称：C_movk 
;;功能：copy回路并移动表格(从图库中取) 
;;输入：plist-点表(所选订货图列的右上角和订货图的右下角) kd-旧回路的宽度 kdn-新回路的宽度 
;;      pjdn-替换回路 fx-回路方向 dist、data1、data2、sm2-调回路库的参数 smov-回路选择集 
;;      a-为时替换回路,为2时插入回路 
;;返回：xlist-新回路列的两个x坐标 
(defun C_movk(plist kd kdn pjdn fx dist data1 data2 sm2 smov a / point1 point2 l point3 
              point4 xlist ss) 
  (setq point1(car plist)) 
  (setq point2(cadr plist)) 
  (if (= a 1) 
    (progn 
      (setq l(- kd kdn)) 
      (setq point3(list(-(car point1)l)(cadr point1)(last point1))) 
      (setq ss(ssget "w" point1 point2)) 
      (h_hlhz pjdn fx dist data1 data2 sm2) 
      (if smov 
        (progn 
          (command "_.move" smov "" point1 point3) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point1 point3) 
      (setq xlist(list(-(car point1)kd)(car point3))) 
    ) 
    (progn 
      (setq point3(list(-(car point1)kd)(cadr point1)(last point1))) 
      (setq point4(list(+(car point3)kdn)(cadr point3)(last point3))) 
      (setq ss (ssget "w" point3 point2)) 
      (h_hlhz pjdn fx dist data1 data2 sm2) 
      (if smov 
        (progn 
          (command "_.move" smov "" point3 point4) 
          (setq ss(C_ssgl ss smov)) 
        ) 
      ) 
      (command "_.move" ss "" point3 point4) 
      (setq xlist(list(car point3)(car point4))) 
    ) 
  ) 
  xlist 
) 
 
;;=================================子函数开始================================= 
;;名称：C_hlin 
;;功能：画横线 
;;输入：xlist-新订货图的x坐标表 ylist-所选订货图所有横线的Y坐标表 hlsm-回路数目 
;;返回：无 
(defun C_hlin(xlist ylist hlsm / point1 point2 i l n) 
  (setq i 0) 
  (setq l(/(abs(-(car xlist)(last xlist)))hlsm)) 
  (repeat (length ylist) 
    (setq n 0) 
    (repeat hlsm 
      (setq point1(list(+(car xlist)(* l n))(nth i ylist)0.0)) 
      (setq point2(list(+(car xlist)(* l (+ n 1)))(nth i ylist)0.0)) 
      (command "_.line" point1 point2 "") 
      (setq n (+ n 1)) 
    ) 
    (setq i (+ i 1)) 
  ) 
) 
 
;;=================================子函数开始================================= 
;;名称：s_px 
;;功能：排序(从大到小) 
;;输入：ylist-所选订货图所有横线的Y坐标表 
;;返回：nylist 
  (defun s_px(ylist / i nylist yy list1 list2) 
    (setq nylist '()) 
    (while (/= (length ylist) 0) 
      (setq i 1) 
      (setq yy (nth 0 ylist)) 
      (repeat (-(length ylist)1) 
        (if (> yy (nth i ylist)) 
          (setq yy (nth i ylist)) 
        ) 
        (setq i (+ i 1)) 
      ) 
      (setq nylist (cons yy nylist)) 
      (setq list1 (cdr (member yy ylist))) 
      (setq list2 (cdr (member yy (reverse ylist)))) 
      (setq ylist (append list1 list2)) 
    ) 
    nylist 
  ) 
 
;;=================================子函数开始================================= 
;;名称：C_slin 
;;功能：画竖线 
;;输入：xzb-x坐标 ylist-所选订货图所有横线的Y坐标表 
;;返回：无 
 (defun C_slin(xzb ylist / nylist point1 point2 i) 
  (setq i 0) 
  (setq nylist(s_px ylist)) 
  (repeat (-(length nylist)1) 
    (setq point1(list xzb (nth i nylist))) 
    (setq point2(list xzb (nth (+ i 1) nylist))) 
    (command "_.line" point1 point2 "") 
    (setq i (+ i 1)) 
  ) 
 ) 
   
;;=================================子函数开始================================= 
;;名称：h_comp 
;;功能：计算两值的差(用于排序) 
;;输入：a、b 
;;返回：两值的差 
  (defun h_comp (a b) 
    (- a b) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_inwi 
;;功能: 判断p1是否在p2 p3组成的窗口内 
;;输入: p1 p2 p3 
;;返回: 0-在窗口内、1-在窗口外、nil-边界上 
  (defun h_inwi (p1 p2 p3) 
    (cond 
      ((and(< (car p1) (- (max (car p2) (car p3)) tscale)) 
            (> (car p1) (+ (min (car p2) (car p3)) tscale)) 
            (< (cadr p1) (- (max (cadr p2) (cadr p3)) tscale)) 
            (> (cadr p1) (+ (min (cadr p2) (cadr p3)) tscale)) 
        ) 
        0 
      ) 
      ((or(> (car p1) (+ (max (car p2) (car p3)) tscale)) 
           (< (car p1) (- (min (car p2) (car p3)) tscale)) 
           (> (cadr p1) (+ (max (cadr p2) (cadr p3)) tscale)) 
           (< (cadr p1) (- (min (cadr p2) (cadr p3)) tscale)) 
        ) 
        1 
      ) 
      (t nil) 
    ) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_mxwz 
;;功能: 母线位置判断 
;;输入: emx p1 p2 
;;返回: mxwzt 
  (defun h_mxwz        (emx p1 p2 / pd1 pd2 pc mxwzt) 
    (setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
          pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
    ) 
    (setq pc (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0))) 
    (if        (or (> (car pc) (max (car p1) (car p2))) 
            (> (cadr pc) (max (cadr p1) (cadr p2))) 
            (< (car pc) (min (car p1) (car p2))) 
            (< (cadr pc) (min (cadr p1) (cadr p2))) 
        ) 
      (setq mxwzt nil) 
      (setq mxwzt pc) 
    ) 
    mxwzt 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_wzpd 
;;功能: 位置判断、判断实体（块-插入点，线-二端点）是否在窗口之内 
;;输入: 实体名 窗口二角点 
;;返回: 在窗口内-中点 
;;      不在窗口内-T 
;;      交叉(线)-nil 
  (defun h_wzpd (emx p1 p2 ss / pd1 pd2 pc wzt npd1 npd2 es sins i) 
    (cond 
      ((= (cdr (assoc 0 (entget emx))) "LWPOLYLINE") 
       (setq pd1 (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
             pd2 (append (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
       ) 
       (setq pc        (polar pd1 (angle pd1 pd2)(/ (distance2p pd1 pd2) 2.0))) 
       (setq npd1 (h_inwi pd1 p1 p2) 
             npd2 (h_inwi pd2 p1 p2) 
       ) 
       (cond 
        ((or(and (= npd1 0) (= npd2 1))(and (= npd2 0) (= npd1 1))) 
         (setq wzt nil) 
        ) 
         ((or (= npd1 1) (= npd2 1)) 
          (setq wzt t) 
         ) 
         (t (setq wzt pc)) 
       ) 
      ) 
      (t 
       (setq pc (cdr (assoc 10 (entget emx)))) 
       (cond 
        ((= (h_inwi pc p1 p2) 1) 
          (setq wzt t) 
         ) 
         ((null (h_inwi pc p1 p2)) 
          (if (= (cdr (assoc 0 (entget emx))) "insert") 
            (progn 
              (setq        sins (ssget "c" 
                                    (polar pc (* 0.25 pi) tscale) 
                                    (polar pc (* 0.25 pi) tscale) 
                                    '((0 . "insert,lwpolyline")) 
                             ) 
                  ) 
                  (setq        wzt pc 
                        i   0 
                  ) 
                  (while (and wzt (
                    (setq es (ssname sins i)) 
                    (if        (not (ssmemb es sins)) 
                      (setq wzt t) 
                      (setq i (1+ i)) 
                    ) 
                  ) 
                ) 
                (setq wzt pc) 
              ) 
             ) 
             (t (setq wzt pc)) 
       ) 
      ) 
    ) 
    wzt 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_wzyz 
;;功能: 母线位置一致性判断 
;;输入: 母线 循环号 (方向初值 坐标初值) 
;;返回: i=0 (方向 坐标) 
;;      i/=0 位置一致 t 
;;           位置不一致 nil 
  (defun h_wzyz        (emx i first / fxhsf hszf pmxd1 pmxd2 fxhs hsz wzyz) 
    (setq fxhsf        (car first) 
          hszf        (cadr first) 
    ) 
    (setq pmxd1        (append (cdr (assoc 10 (entget emx))) (list 0.0)) 
          pmxd2        (append        (cdr (assoc 10 (reverse (entget emx))))(list 0.0)) 
    ) 
    (if(equal (car pmxd1) (car pmxd2) 0.001) 
      (setq fxhs 1 hsz (car pmxd1)) 
      (setq fxhs 0 hsz (cadr pmxd1)) 
    ) 
    (if(= i 0) 
      (setq wzyz (list fxhs hsz)) 
      (progn 
        (if (or(not (equal fxhs fxhsf 0.01)) 
                (not (equal hsz hszf 0.01)) 
            ) 
         (setq wzyz nil) 
          (setq wzyz t) 
        ) 
      ) 
    ) 
    wzyz 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_xzhl 
;;功能: 选择回路 
;;输入: 窗口二角点p1，p2 
;;返回: t-(基点 方向? 宽度 回路选择集 回路数) 方向--0 向下 1 向右 2 向上 3 向左 
;;       NIL-nil 
  (defun h_xzhl        (p1    p2    /           ssfah fah   pjd   fx           sshl         hlsm 
                 kd    hll   smx   i         mxt   fxhs  hsz   len1         ii 
                 emx   iii   pd1   pd2         mxmin mxmax p1           p2         pc 
                 ss    i4    pcl   first e     pcxl  pcyl  pcc   xzt 
                 len2 
                ) 
    (setq hll nil) 
    (setq smx (ssget "c" p1 p2 '((0 . "lwpolyline") (8 . "mx")))) 
    (if        smx 
      (progn 
        (setq i        0 mxt t) 
        (while (and mxt (
          (setq emx (ssname smx i)) 
          (if (= i 0) 
            (setq first (h_wzyz emx 0 nil)) 
            (setq mxt (h_wzyz emx i first)) 
          ) 
          (setq i (1+ i)) 
        )                                ;判断母线位置一致性 
        (if mxt 
          (progn 
            (setq fxhs (car first) 
                  hsz  (cadr first) 
                  ii   0 
                  len1 (sslength smx) 
            ) 
            (repeat len1 
              (setq emx (ssname smx ii)) 
              (if (h_mxwz emx p1 p2) 
                (setq ii (1+ ii)) 
                (ssdel emx smx) 
              ) 
            )                                ;删除中心在边界外的母线 
            (setq hlsm (sslength smx)) 
            (if        (/= hlsm 0) 
              (progn 
                (setq iii 0) 
                (repeat        hlsm 
                  (setq emx (ssname smx iii)) 
                  (setq        pd1 (cdr (assoc 10 (entget emx))) 
                        pd2 (cdr (assoc 10 (reverse (entget emx)))) 
                  ) 
                  (if (= fxhs 0) 
                    (if        (= iii 0) 
                      (setq mxmin (min (car pd1) (car pd2)) 
                            mxmax (max (car pd1) (car pd2)) 
                      ) 
                      (progn 
                        (if (< (min (car pd1) (car pd2)) mxmin) 
                          (setq mxmin (min (car pd1) (car pd2))) 
                        ) 
                        (if (> (max (car pd1) (car pd2)) mxmax) 
                          (setq mxmax (max (car pd1) (car pd2))) 
                        ) 
                      ) 
                    ) 
                    (if        (= iii 0) 
                      (setq mxmin (min (cadr pd1) (cadr pd2)) 
                            mxmax (max (cadr pd1) (cadr pd2)) 
                      ) 
                      (progn 
                        (if (< (min (cadr pd1) (cadr pd2)) mxmin) 
                          (setq mxmin (min (cadr pd1) (cadr pd2))) 
                        ) 
                        (if (> (max (cadr pd1) (cadr pd2)) mxmax) 
                          (setq mxmax (max (cadr pd1) (cadr pd2))) 
                        ) 
                      ) 
                    ) 
                  ) 
                  (setq iii (1+ iii)) 
                ) 
                (setq kd (- mxmax mxmin)) 
                (if (= fxhs 0) 
                  (setq        p1  (list mxmin (cadr p1) 0.0) 
                        p2  (list mxmax (cadr p2) 0.0) 
                        pjd (list (/ (+ mxmin mxmax) 2) hsz 0.0) 
                  ) 
                  (setq        p1  (list (car p1) mxmin 0.0) 
                        p2  (list (car p2) mxmax 0.0) 
                        pjd (list hsz (/ (+ mxmin mxmax) 2) 0.0) 
                  ) 
                )                        ;取得母线范围并更新选择集窗口 
 
                (setq ss (ssget "c" p1 p2 '((8 . "mx,fah,bxt,xhgg,xmdh")))) 
                (setq i4   0 
                      pcl  nil 
                      len2 (sslength ss) 
                      xzt  t 
                ) 
                (while (and xzt (< i4 len2)) 
                  (setq e (ssname ss i4)) 
                  (if (setq pc (h_wzpd e p1 p2 smx)) 
                    (progn 
                      (if (= pc t) 
                        (progn 
                          (ssdel e ss) 
                          (setq len2 (1- len2)) 
                        ) 
                        (progn 
                          (setq pcl (cons pc pcl)) 
                          (setq i4 (1+ i4)) 
                        ) 
                      ) 
                    ) 
                    (setq xzt nil) 
                  ) 
                ) 
                                        ;去掉多余实体,如果交叉结束 
                (if xzt 
                  (progn 
                    (setq pcxl (mapcar 'car pcl) 
                          pcyl (mapcar 'cadr pcl) 
                    ) 
                    (setq pcc (list (/ (apply '+ pcxl) (length pcl)) 
                                    (/ (apply '+ pcyl) (length pcl)) 
                                    0.0 
                              ) 
                    ) 
                    (if        (= fxhs 0) 
                      (if (< (cadr pcc) (cadr pjd)) 
                        (setq fx 0) 
                        (setq fx 2) 
                      ) 
                      (if (> (car pcc) (car pjd)) 
                        (setq fx 1) 
                        (setq fx 3) 
                      ) 
                    ) 
                    (setq hll (list pjd fx kd ss hlsm)) 
                  ) 
                  (Xacino "回路选择不完整!" "操作错误" 6) 
                ) 
              ) 
            ) 
          ) 
          (Xacino "选了其他回路的母线!" "操作错误" 6) 
        ) 
      ) 
    ) 
    hll 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_lxdd 
;;功能: 连续母线端点 
;;输入: 端点 方向 
;;返回: 下一端点 
  (defun h_lxdd        (pds fx hljj / p1 p2 lxl pde e hs smxal) 
    (setq pde nil) 
    (setq smxal (ssget "x" '((8 . "mx")))) 
    (if(or (= fx 0) (= fx 2)) 
      (setq lxl (list (car pds))) 
      (setq lxl (list (cadr pds))) 
    ) 
    (while (setq e (ssname smxal 0)) 
      (setq p1 (cdr (assoc 10 (entget e))) 
            p2 (cdr (assoc 10 (reverse (entget e)))) 
      ) 
      (if (or (= fx 0) (= fx 2)) 
        (if (and (equal (cadr p1) (cadr pds) 0.001) 
                 (equal (cadr p2) (cadr pds) 0.001) 
            ) 
          (if (> (setq hs (max (car p1) (car p2))) (car pds)) 
            (setq lxl (cons hs lxl)) 
          ) 
        ) 
        (if (and (equal (car p1) (car pds) 0.001) 
                 (equal (car p2) (car pds) 0.001) 
            ) 
          (if (> (setq hs (max (cadr p1) (cadr p2))) (cadr pds)) 
            (setq lxl (cons hs lxl)) 
          ) 
        ) 
      ) 
      (ssdel e smxal) 
    ) 
    (if(> (length lxl) 1) 
      (setq lxl (qsort h_comp lxl)) 
    ) 
    (while (and        (> (length lxl) 1) 
                (< (- (cadr lxl) (car lxl)) (* 1.5 hljj)) 
           ) 
      (setq lxl (cdr lxl)) 
      (if (or (= fx 0) (= fx 2)) 
        (setq pde (list(car lxl)(cadr pds)        0.0)) 
        (setq pde (list(car pds)(car lxl)        0.0)) 
      ) 
    ) 
    pde 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_lxxz 
;;功能: 连续回路选择,选择由一点开始的所有连续同方向回路 
;;输入: 开始点 结束点 方向 
;;返回: 选择集 
  (defun h_lxxz        (pds pde fx / p1 p2 ss i ls emx dqw1 wzpdt) 
    (setq ss nil) 
    (if        (and pds pde) 
      (progn 
        (cond 
          ((= fx 0) 
           (setq p1 (polar pds (* 1.5 pi) (* 90 tscale)) 
                 p2 (polar pde (* 0.5 pi) (* 2 tscale)) 
           ) 
          ) 
          ((= fx 1) 
           (setq p1 (polar pds pi (* 2 tscale)) 
                 p2 (polar pde 0 (* 90 tscale)) 
           ) 
          ) 
          ((= fx 2) 
           (setq p1 (polar pds (* 1.5 pi) (* 2 tscale)) 
                 p2 (polar pde (* 0.5 pi) (* 90 tscale)) 
           ) 
          ) 
          ((= fx 3) 
           (setq p1 (polar pds pi (* 90 tscale)) 
                 p2 (polar pde 0 (* 2 tscale)) 
           ) 
          ) 
        ) 
        (setq dqw1 (XScjx)) 
        (if (or        (= (h_inwi p1 (car dqw1) (cadr dqw1)) 1) 
                (= (h_inwi p2 (car dqw1) (cadr dqw1)) 1) 
            ) 
          (progn 
            (command "_.zoom" 
                     (list (min (car p1) (caar dqw1)) 
                           (min (cadr p1) (cadar dqw1)) 
                     ) 
                     (list (max (car p2) (caadr dqw1)) 
                           (max (cadr p2) (cadadr dqw1)) 
                     ) 
            ) 
          ) 
        ) 
        (setq ss (ssget "c" p1 p2 '((8 . "mx,bxt,fah,xhgg,xmdh")))) 
 
        (setq i         0 
              ls (sslength ss) 
        ) 
        (repeat        ls 
          (setq emx (ssname ss i)) 
          (setq wzpdt (h_wzpd emx p1 p2 ss)) 
          (if (or (null wzpdt) (= wzpdt t)) 
            (ssdel emx ss) 
            (setq i (1+ i)) 
          ) 
        ) 
      ) 
    ) 
    ss 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_hlhz 
;;功能: 回路绘制 
;;输入: 回路起始点 方向 回路间距 
;;返回: 无 
  (defun h_hlhz(pjd fx dist data1 data2 sm2 / zdist pds pdmx2 pdmx1 mxkd shu) 
    (setq zdist (* sm2 dist)) 
    (Xsetin "Hlklib" "Hlkjj" (rtos (/ dist tscale) 2 2) 1) 
    (shldy pjd fx data1 data2)                ;回路绘制 
    (command "_.color" "_green") 
    (command "_.Layer" "_m" "mx" "_c" 3 "" "") 
    (if        (or (= fx 0) (= fx 2)) 
      (setq pds (polar pjd 0 (* -0.5 zdist))) 
      (setq pds (polar pjd (* 0.5 pi) (* -0.5 zdist))) 
    ) 
    (setq pdmx1 pds) 
    (repeat sm2 
      (if (or (= fx 0) (= fx 2)) 
        (setq pdmx2 (polar pdmx1 0 dist)) 
        (setq pdmx2 (polar pdmx1 (* 0.5 pi) dist)) 
      ) 
      (setq mxkd (atof (Xgetin "Hlklib" "Hlkmx" "0.6" 1))) 
      (setq mxkd (* mxkd tscale)) 
      (command "_.pline" pdmx1 "_w" mxkd "" pdmx2 "") 
      (setq pdmx1 pdmx2) 
    )                                        ;母线绘制 
    (setq shu(tblsearch "layer""GDXT")) 
    (if shu(command "_.layer" "_set" "GDXT" "")) 
  ) 
 
;;=================================子函数开始================================= 
;;名称: h_sh4 
;;功能: 回路删除 
;;输入: 无 
;;返回: 无 
(defun h_sh4 (/ lll1 ph1 ph2 ttt1 hlxzl pjd fx kd sshl hlsm pmde jj dist pmds 
                sm2 smov zxj ysj mylist plist pmdsn ss1 ss2 ylist xlist fan s4_xc 
                s4_glx shu) 
 
;;=================================子函数开始================================= 
;;名称: s4_glx 
;;功能: 过滤x坐标一定的所有竖线 
;;输入: ss-选择集 xlist-x坐标 mylist-定货图的两个角点 
;;返回: ss 
(defun s4_glx(ss xlist mylist / point1 point2 point3 point4 ss1 ss2) 
  (setq point1(list (car xlist)(cadr(car mylist)))) 
  (setq point2(list (car xlist)(cadr(cadr mylist)))) 
  (setq point3(list (last xlist)(cadr(car mylist)))) 
  (setq point4(list (last xlist)(cadr(cadr mylist)))) 
  (setq ss1(ssget "W" point1 point2 '((0 . "LINE")(8 . "GDXT")))) 
  (setq ss2(ssget "W" point3 point4 '((0 . "LINE")(8 . "GDXT")))) 
  (if ss1 (setq ss(C_ssgl ss ss1))) 
  (if ss2 (setq ss(C_ssgl ss ss2))) 
  ss 
) 
 
;;=================================子函数开始================================= 
;;名称: s4_xc 
;;功能: 消重直线 
;;输入: xlist-x坐标 mylist-定货图的两个角点 ylist-y坐标表 
;;返回: 无 
(defun s4_xc(xlist mylist ylist pjd / point point1 point2 point3 point4 ss1 ss2) 
  (setq point(list(last xlist)(cadr pjd)(last pjd))) 
  (setq point1(list(last xlist)(cadr(cadr mylist)))) 
  (setq point2(list(last xlist)(cadr(car mylist)))) 
  (setq point3(list(-(car point)10)(+(cadr point)10))) 
  (setq point4(list(+(car point)10)(-(cadr point)10))) 
  (setq ss1(ssget "W" point1 point2 '((0 . "LINE")(8 . "GDXT")))) 
  (setq ss2(ssget "C" point3 point4 '((0 . "LINE")(8 . "GDXT")(62 . 3)))) 
  (if ss2(progn(C_slin (last xlist) ylist)(command "_.erase" ss1 ""))) 
) 
;;h_sh4主函数开始 
  (setq zxj(car(XScjx))) 
  (setq ysj(last(XScjx))) 
  (setq lll1 t) 
  (while lll1 
    (command "_.undo" "_group") 
    (setq shu(tblsearch "layer""GDXT")) 
    (if shu(command "_.layer" "_set" "GDXT" "")) 
    (setq fan 1) 
    (prompt "\n请用窗口(W)选择删除回路:") 
    (setq ph1 1) 
    (while(not(listp ph1)) 
      (initget 128) 
      (setq ph1 (getpoint "\n请输入窗口第一点<回车结束>:")) 
    ) 
    (if ph1 
      (progn 
        (setq ttt1 t) 
        (while ttt1 
          (setq ph2 1) 
          (while(not(listp ph2)) 
            (initget 128) 
            (setq ph2 (getcorner ph1 "\n请输入窗口第二点:")) 
          ) 
          (if ph2 
            (progn 
              (setq hlxzl(h_xzhl ph1 ph2)) 
              (if hlxzl 
                (progn 
                  (setq ttt1 nil) 
                  (setq pjd  (nth 0 hlxzl) 
                        fx   (nth 1 hlxzl) 
                        kd   (nth 2 hlxzl) 
                        sshl (nth 3 hlxzl) 
                        hlsm (nth 4 hlxzl) 
                  ) 
                  (setq jj(/ kd hlsm)) 
                  (if(or(= fx 0)(= fx 2)) 
                    (setq pmds(polar pjd 0(/ kd 2.0)) pmdsn(polar pjd 0(/ kd -2.0))) 
                    (setq pmds(polar pjd(* 0.5 pi)(/ kd 2.0)) 
                          pmdsn (polar pjd(* 0.5 pi)(/ kd -2.0)) 
                    ) 
                  ) 
                  (setq pmde (h_lxdd pmds fx jj)) 
                  (setq smov (h_lxxz pmds pmde fx)) 
                  (setq mylist(dhtss pmds 2)) 
                  (if(and(or(= fx 0)(= fx 2))mylist) 
                    (progn 
                      (C_zoom mylist zxj ysj) 
                      (setq ylist (C_xyzb mylist pjd kd)) 
                      (setq plist (C_ldel mylist pjd kd sshl)) 
                      (setq ss1 (ssget "w" (car plist)(cadr plist))) 
                      (setq ss2 (last plist)) 
                      (setq xlist(list(car pmds)(car pmdsn))) 
                      (setq ss2 (s4_glx ss2 xlist mylist)) 
                      (command "_.erase" sshl "") 
                      (command "_.erase" ss2 "") 
                      (if smov 
                        (progn 
                          (command "_.move" smov "" pmds pmdsn) 
                          (setq ss1 (C_ssgl ss1 smov)) 
                        ) 
                      ) 
                      (command "_.move" ss1 "" pmds pmdsn) 
                      (s4_xc xlist mylist ylist pjd) 
                      (Command "_.zoom" zxj ysj) 
                    ) 
                    (progn 
                      (if smov (command "_.move" smov "" pmds pmdsn)) 
                      (command "_.erase" sshl "") 
                    ) 
                  ) 
                ) 
                (setq ttt1 nil) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (setq lll1 nil) 
    ) 
    (command "_.undo" "_end") 
    (setq fan 0) 
  ) 
) 
   
;;================================子函数结束================================== 
  (_inidwg) 
  (princ "\n*回路删除*=Hldel") 
  (setvar "plinetype" 2) 
  (setvar "cmdecho" 0) 
  (setvar "blipmode" 0) 
  (setvar "pickadd" 1) 
  (setvar "osmode" 0) 
  (setvar "CECOLOR" "green") 
  (setq ucmark (getvar "worlducs")) 
  (if (= ucmark 0) 
    (progn 
      (setq ucs_fo (getvar "ucsfollow")) 
      (if (= ucs_fo 1)(setvar "ucsfollow" 0)) 
      (command "_.ucs" "_world") 
    ) 
  ) 
  (setq lxfs 0 tscale(atof(xrddic "Tabscale" "100")) dqw(XScjx)) 
  (setq        o_para(xgetin "Hlklib" "Hlkpara" "" 1) 
        o_mes(xgetin "Hlklib" "RetHlkMes" "" 1) 
        o_jj(xgetin "Hlklib" "Hlkjj" "30" 1) 
  ) 
  (menucmd "s=hd25l") 
  (h_sh4) 
  (if(= ucmark 0)(command "_.ucs" "_prev")) 
  (setvar "highlight" 1) 
  (setq dqwn(XScjx)) 
  (if(not(equal dqw dqwn(* 0.1 tscale)))(command "_.zoom" (car dqw) (cadr dqw))) 
  (setq *error* olderr olderr nil) 
  (_resdwg) 
  (princ) 
)

小菜 · 发表于 2006-2-13 08:25:40

这个是什么软件里面的？

zb_lou · 发表于 2006-2-14 17:43:22

看不明白。。什么作用？

雨箭风刀 · 发表于 2006-2-14 18:11:14

hehe，好长。看来楼主花了不少心思，鼓励一下！

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：回路替换-名称：C:HLTH

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子