多点打断
(defun c:br ()(setq ent (car (entsel "\n请选择被打断线段:")))
(while (setq p (getpoint "\n请选择断点:"))
(command "_.break" ent p "@"))
(princ))
用途：实现线段的多点打断
实现不了，不知道问题出在了什么地方，高手求助 (defun c:br1 ()
(setq ent (entsel "\n请选择被打断线段:"))
(while (setq p (getpoint "\n请选择断点:"))
(command "_.break" ent "F" p "@")
)
(princ)
)
这段程序只能有50%概率能连续打断，这是因为线条打断后，变成两个实体，只有一半的概率打断点位于早先拾取实体名上。 本帖最后由 langjs 于 2013-8-17 10:12 编辑
稍微修改一下，解决楼上一半概率问题
(defun c:br1 ( / pt ss)
(setvar "cmdecho" 0)
(while (setq pt (getpoint "\n指定打断点:"))
(if (setq ss (ssget "c" pt pt))
(command "_.break" (list (ssname ss 0) pt) "F" pt "@")
)
)
(princ)
)
langjs 发表于 2013-8-16 22:03 static/image/common/back.gif
稍微修改一下，解决楼上一半概率问题
(defun c:ReinYinXian (/
;局部函数
#erryx001 $orr
PEACE:SaveSysVarPeace
PEACE:ReadSysVarPeace
PEACE:StoreSysVar
PEACE:RestoreSysVar
reent
relst
Sort_pList
SaveSysVar
GETDATA
PEACE:CoordChange
PEACE:Assoc_ItemList
PEACE:Point_CenterPoint
tan
PEACE:Point_OffsetPointD
PEACE:PointList_OffsetPointYR
PEACE:PointList_OffsetPointYL
;局部参数
bb bi code data dcl_re dclname ent ent1 ent2 ent3 filen
gr i lst name1 name2 name3 nent pt pt0 ptlst stream
tempname w w1 w2 x x0 x1 xunh y0 y1 en end end_data
centerp centerplst centerplsti endplst endp endplstL2R
entname tstyle
;全局参数
;PEACE:RYX_TxtUp
;PEACE:RYX_TxtDn
;PEACE:RYX_TextH
;PEACE:RYX_TextW2H
;PEACE:RYX_TextD
;PEACE:RYX_TextColor
;PEACE:RYX_TextLayer
;PEACE:RYX_DIML
;PEACE:RYX_DIMColor
;PEACE:RYX_DIMLayer
;PEACE:RYX_Ratio
)
(defun #erryx001 (s / i)
(setq i 0)
(repeat (length entname)
(entdel (nth i entname))
(setq i (1+ i))
)
(PEACE:RestoreSysVar) ;还原系统变量
(command ".UNDO" "E")
(setq *error* $orr)
)
;函数区域开始===============
;保存peace系统变量，保存到cad安装目录下的PEACESYSVAL.TXT by PEACE 2013/05/25
(defun PEACE:SaveSysVarPeace(valname valvalue infotext / acadpath f datalist data valvalue_old i isthere)
(setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
(if (= infotext "")(setq infotext "no infotext"))
(if (null (findfile "PEACESYSVAL.TXT"))
(progn ;若文件不存在
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
(prin1 (list valname valvalue infotext) f)
(close f)
)
(progn ;若文件已存在
(setq datalist '())
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
(while (setq data (read-line f))
(setq datalist (cons data datalist))
)
(close f)
(setq datalist (reverse datalist))
(setq i 0
isthere 0)
(repeat (length datalist)
(if (= valname (car (read (nth i datalist))))
(progn
(setq datalist (subst (vl-prin1-to-string (list valname valvalue infotext)) (nth i datalist) datalist))
(setq isthere 1)
)
)
(setq i (1+ i))
)
(if (= 1 isthere)
(progn
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
(prin1 (read (nth 0 datalist)) f)
(close f)
(setq i 1)
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
(repeat (- (length datalist) 1)
(write-line "" f)
(prin1 (read (nth i datalist)) f)
(setq i (1+ i))
)
(close f)
)
(progn
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
(write-line "" f)
(prin1 (list valname valvalue infotext) f)
(close f)
)
)
)
)
(princ)
)
;读取peace系统变量 by PEACE 2013/05/25
(defun PEACE:ReadSysVarPeace( / acadpath data datalist i f)
(setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
(if (findfile "PEACESYSVAL.TXT")
(progn
(setq datalist '())
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
(while (setq data (read-line f))
(setq datalist (cons data datalist))
)
(reverse datalist)
(close f)
(setq i 0)
(repeat (length datalist)
(set (read (car (read (nth i datalist)))) ;注意字符和表之间的转换，字符串是不能作为变量名的
(cadr (read (nth i datalist))) ;car对字符串也是不起作用的
)
(setq i (1+ i))
)
)
nil
)
)
;存储系统变量
(defun PEACE:StoreSysVar()
(setq vcmde (getvar "CMDECHO"));普通命令的提示
(setq vblip (getvar "blipmode")) ;光标痕迹
(setq vclay (getvar "CLAYER")) ;图层
(setq vosmo (getvar "osmode")) ;捕捉模式
(setq vplwd (getvar "plinewid")) ;pl宽度
(setq vlupr (getvar "luprec")) ;长度精度
)
;还原系统变量
(defun PEACE:RestoreSysVar()
(setvar "CMDECHO" vcmde)
(setvar "blipmode" vblip)
(setvar "CLAYER" vclay)
(setvar "osmode" vosmo)
(setvar "plinewid" vplwd)
(setvar "luprec" vlupr)
)
; 按点表顺序更新多段线顶点,无须更换的顶点用nil代替。by:langjs
(defun reent (ent ptlst / i nent x)
(setq i -1
nent '()
)
(foreach x ent
(setq nent (append
nent
(list (if (and
(= (car x) 10)
(/= (nth (setq i (1+ i)) ptlst) nil)
)
(cons 10 (nth i ptlst))
x
)
)
)
)
)
)
; 替换表中第i个元素。
(defun relst (x i lst)
(if (= 0 i)
(cons x (cdr lst))
(cons (car lst) (relst x (1- i) (cdr lst)))
)
)
;;二维坐标排序
;;"D->U"从下到上;"U->D"从上到下;"L->R"从左到右;"R->L"从右到左
;;排序有先后，若调用如：(Sort_pList plist "D->U" "L->R")，
;;则整体按y从小到大排序，遇x值相同时，按x从小到大排序
(defun Sort_pList (PLIST Sort1 Sort2 / Symbol1 Symbol2 plistout)
(vl-load-com)
(cond
((member Sort1 (list "L->R" "R->L")) ;若sort1为"L->R"或"R->L"，则先x向排序后y向排序，反之亦然
(cond ((= Sort1 "L->R") (setq Symbol1 '<)) ;若sort1="L->R",则(eval Symbol1)=>
(T (setq Symbol1 '>)) ;否则Symbol1=<
)
(cond ((= Sort2 "D->U") (setq Symbol2 '<)) ;若sort2="D->U",则(eval Symbol2)=>
(T (setq Symbol2 '>)) ;否则Symbol2=<
)
(setq plistout
(vl-sort
PLIST
'(lambda (p1 p2)
(cond (((eval Symbol1) (car p1) (car p2)) T)
((and (= (car p1) (car p2))
((eval Symbol2) (cadr p1) (cadr p2))
)
T
)
)
)
)
)
)
(T
(cond ((= Sort1 "D->U") (setq Symbol1 '<))
(T (setq Symbol1 '>))
)
(cond ((= Sort2 "L->R") (setq Symbol2 '<))
(T (setq Symbol2 '>))
)
(setq plistout
(vl-sort
PLIST
'(lambda (p1 p2)
(cond (((eval Symbol1) (cadr p1) (cadr p2)) T)
((and (= (cadr p1) (cadr p2))
((eval Symbol2) (car p1) (car p2))
)
T
)
)
)
)
)
)
)
plistout
)
;;;把坐标值转换成一定小数位数的坐标 by PEACE 2013/04/22
;;;POINT=需要转换的点,FRACTLEN=小数位数，若小于0则自动赋予0，若为正实数，则自动转换成正整数
(defun PEACE:CoordChange(point fractlen / x y)
(if (< fractlen 0)
(setq fractlen 0)
)
(setq fractlen (fix fractlen))
(setq x (PEACE:NUMformat (car point) fractlen))
(setq y (PEACE:NUMformat (cadr point) fractlen))
(setq point (list x y))
point
)
;;;获取表(Alist)中索引码(Item)相同的所有元素,并组成一个表(lst)返回
(defun PEACE:Assoc_ItemList (Item Alist / a lst point)
(while (setq a (assoc Item Alist))
(setqAlist (cdr (member a Alist)) ;cdr返回list(member a Alist)中除了第一个以外的所有元素的表
point (cdr a)
lst (cons point lst)
)
)
(reverse lst) ;前面获得的坐标表是倒序的，现在再转换为正序
)
;;;获取点表中所有点的中心点 by PEACE 2013/06/28
;;;plst=点表isz=T （包含Z坐标） nil （不包含Z坐标）
(defun PEACE:Point_CenterPoint(plst isz / n x y z i centerpoint)
(setq n (length plst))
(setq x 0 y 0 i 0)
(if (= isz T) (setq z 0))
(repeat n
(setq x (+ x (car (nth i plst)))
y (+ y (cadr (nth i plst)))
)
(if (= isz T) (setq z (+ z (caddr (nth i plst)))))
(setq i (1+ i))
)
(if (= isz T)
(setq centerpoint (list (/ x n) (/ y n) (/ z n)))
(setq centerpoint (list (/ x n) (/ y n)))
)
centerpoint
)
;; Tangent-Lee Mac
;; Args: x - real
(defun tan ( x )
(if (not (equal 0.0 (cos x) 1e-10))
(/ (sin x) (cos x))
)
)
;;;根据距离和角度获取一个点表的偏移点表 by PEACE 2013/06/28
;;;plst=原始点表 d=距离 ang=角度（弧度）
(defun PEACE:Point_OffsetPointD(plst d ang / n newplst i p newp x0 y0)
(setq n (length plst)
newplst '()
i 0
)
(repeat n
(setq p (nth i plst)
x0 (car p)
y0 (cadr p)
x (+ x0 (* d (cos ang)))
y (+ y0 (* d (sin ang)))
newp (list x y)
newplst (cons newp newplst)
i (1+ i)
)
)
(setq newplst (reverse newplst))
newplst
)
;;;根据新y值形成新的偏移点表,新点均在基点右侧 by PEACE 2013/06/28
;;;plst=原始点表 vy=y坐标 ang=角度（弧度）
(defun PEACE:PointList_OffsetPointYR(plst vy ang / n newplst i p newp x0 y0)
(setq n (length plst)
newplst '()
i 0
)
(repeat n
(setq p (nth i plst)
x0 (car p)
y0 (cadr p)
)
(if (> x0 (+ x0 (* (- vy y0) (/ (cos ang) (sin ang)))))
(setq ang (- pi ang))
)
(setq x (+ x0 (* (- vy y0) (/ (cos ang) (sin ang))))
newp (list x vy)
newplst (cons newp newplst)
i (1+ i)
)
)
(setq newplst (reverse newplst))
newplst
)
;;;根据新y值形成新的偏移点表,新点均在基点左侧 by PEACE 2013/06/28
;;;plst=原始点表 vy=y坐标 ang=角度（弧度）
(defun PEACE:PointList_OffsetPointYL(plst vy ang / n newplst i p newp x0 y0)
(setq n (length plst)
newplst '()
i 0
)
(repeat n
(setq p (nth i plst)
x0 (car p)
y0 (cadr p)
)
(if (< x0 (+ x0 (* (- vy y0) (/ (cos ang) (sin ang)))))
(setq ang (- pi ang))
)
(setq x (+ x0 (* (- vy y0) (/ (cos ang) (sin ang))))
newp (list x vy)
newplst (cons newp newplst)
i (1+ i)
)
)
(setq newplst (reverse newplst))
newplst
)
;;;根据新X值形成新的偏移点表,新点均在基点上侧 by PEACE 2013/07/06
;;;plst=原始点表 vx=x坐标 ang=角度（弧度）
(defun PEACE:PointList_OffsetPointXU(plst vx ang / n newplst i p newp x0 y0)
(setq n (length plst)
newplst '()
i 0
)
(repeat n
(setq p (nth i plst)
x0 (car p)
y0 (cadr p)
)
(if (> y0 (+ y0 (* (- vx x0) (/ (sin ang) (cos ang)))))
(setq ang (- pi ang))
)
(setq y (+ y0 (* (- vx x0) (/ (sin ang) (cos ang))))
newp (list vx y)
newplst (cons newp newplst)
i (1+ i)
)
)
(setq newplst (reverse newplst))
newplst
)
;;;根据新X值形成新的偏移点表,新点均在基点下侧 by PEACE 2013/07/06
;;;plst=原始点表 vx=x坐标 ang=角度（弧度）
(defun PEACE:PointList_OffsetPointXD(plst vx ang / n newplst i p newp x0 y0)
(setq n (length plst)
newplst '()
i 0
)
(repeat n
(setq p (nth i plst)
x0 (car p)
y0 (cadr p)
)
(if (< y0 (+ y0 (* (- vx x0) (/ (sin ang) (cos ang)))))
(setq ang (- pi ang))
)
(setq y (+ y0 (* (- vx x0) (/ (sin ang) (cos ang))))
newp (list vx y)
newplst (cons newp newplst)
i (1+ i)
)
)
(setq newplst (reverse newplst))
newplst
)
;;;由pt1根据Δx\Δy\Δz得到pt2by PEACE 2013/07/06
;;;对于二维点和三维点均适用，二维点时dz不起作用
(defun PEACE:Point_Offset (pt1 dx dy dz / x y z pt2)
(setq x (+ (car pt1) dx)
y (+ (cadr pt1) dy)
)
(if (= (length PT1) 3)
(setq z (+ (caddr pt1) dz)
pt2 (list x y z)
)
(setq pt2 (list x y))
)
pt2
)
(defun SaveSysVar()
(PEACE:SaveSysVarPeace "PEACE:RYX_TxtUp" PEACE:RYX_TxtUp "RYX上排文字")
(PEACE:SaveSysVarPeace "PEACE:RYX_TxtDn" PEACE:RYX_TxtDn "RYX下排文字")
(PEACE:SaveSysVarPeace "PEACE:RYX_DIR" PEACE:RYX_DIR "RYX标注方向")
(PEACE:SaveSysVarPeace "PEACE:RYX_TextH" PEACE:RYX_TextH "RYX文字高度")
(PEACE:SaveSysVarPeace "PEACE:RYX_TextW2H" PEACE:RYX_TextW2H "RYX文字宽高比")
(PEACE:SaveSysVarPeace "PEACE:RYX_TextD" PEACE:RYX_TextD "RYX文字偏移")
(PEACE:SaveSysVarPeace "PEACE:RYX_TextColor" PEACE:RYX_TextColor "RYX文字颜色")
(PEACE:SaveSysVarPeace "PEACE:RYX_TextLayer" PEACE:RYX_TextLayer "RYX文字图层")
(PEACE:SaveSysVarPeace "PEACE:RYX_DIMColor" PEACE:RYX_DIMColor "RYX引线颜色")
(PEACE:SaveSysVarPeace "PEACE:RYX_DIMLayer" PEACE:RYX_DIMLayer "RYX引线图层")
(PEACE:SaveSysVarPeace "PEACE:RYX_Ratio" PEACE:RYX_Ratio "RYX出图比例")
)
(defun GETDATA()
(setq PEACE:RYX_TextH (atof (get_tile "e00"))
PEACE:RYX_TextColor (atoi (get_tile "e03"))
PEACE:RYX_DIMColor (atoi (get_tile "e05"))
PEACE:RYX_TextD (atof (get_tile "e02"))
PEACE:RYX_TextW2H (atof (get_tile "e01"))
PEACE:RYX_TextLayer (get_tile "e04")
PEACE:RYX_DIMLayer (get_tile "e06")
PEACE:RYX_Ratio (atof (get_tile "e07"))
bi (/ PEACE:RYX_Ratio 100)
)
)
(defun GETDATAa()
(setq PEACE:RYX_TxtUp (get_tile "ea01")
PEACE:RYX_TxtDn (get_tile "ea02")
PEACE:RYX_DIR (atoi (get_tile "ea03"))
)
)
;局部函数结束=====
(command ".UNDO" "BE")
(PEACE:StoreSysVar);储存系统变量
(PEACE:ReadSysVarPeace)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq $orr *error*)
(setq *error* #erryx001)
(if (not PEACE:RYX_TxtUp)(setq PEACE:RYX_TxtUp ""));上排文字
(if (not PEACE:RYX_TxtDn)(setq PEACE:RYX_TxtDn ""));下排文字
(if (not PEACE:RYX_DIR)(setq PEACE:RYX_DIR 0));标注方向
(if (not PEACE:RYX_TextH)(setq PEACE:RYX_TextH 350));文字高度
(if (not PEACE:RYX_TextW2H)(setq PEACE:RYX_TextW2H 0.7));文字宽高比
(if (not PEACE:RYX_TextD)(setq PEACE:RYX_TextD 100));文字偏移
(if (not PEACE:RYX_TextColor)(setq PEACE:RYX_TextColor 7));文字颜色
(if (or (not PEACE:RYX_TextLayer)(= "" PEACE:RYX_TextLayer)) (setq PEACE:RYX_TextLayer "J-TEXT"));文字图层
(if (not PEACE:RYX_DIMColor)(setq PEACE:RYX_DIMColor 7));引线颜色
(if (or (not PEACE:RYX_DIMLayer)(= "" PEACE:RYX_DIMLayer)) (setq PEACE:RYX_DIMLayer "J-THIN"));引线图层
(if (not PEACE:RYX_Ratio) (setq PEACE:RYX_Ratio 100));出图比例
(setq bi (/ PEACE:RYX_Ratio 100)
xunh t
bb 3
centerplst '()
tstyle (getvar "TEXTSTYLE")
)
(if (null ptlast)
(setq ptlast '(0.0 0.0))
)
(while (= bb 3)
(setq dclname (cond
((setq tempname (vl-filename-mktemp "yx.dcl")
filen (open tempname "w")
)
(foreach stream '("\n" "yx1:dialog {\n"
" label = \"点筋引线标柱\" ;\n"
" :row { :edit_box { label = \"上排文字\" ; key = \"ea01\" ; width = 30 ; height = 1.2 ;}}\n"
" :row { :edit_box { label = \"下排文字\" ; key = \"ea02\" ; width = 30 ; height = 1.2 ;}}\n"
" :row { :toggle { label = \"竖向标注(勾选)/水平标注(不勾选)\" ; key = \"ea03\" ;}}\n"
" :row { :button { key = \"ea04\" ; label = \"确认\" ;is_default = true ; }\n"
" :button { key = \"ea05\" ; label = \"设置\" ; }\n"
" :button { key = \"ea06\" ; label = \"取消\" ; is_cancel = true ; } } }\n"
)
(princ stream filen)
)
(close filen)
tempname
)
)
)
(setq dcl_re (load_dialog dclname))
(if (not (new_dialog "yx1" dcl_re))
(exit)
)
(mode_tile "ea04" 2)
(set_tile "ea01" PEACE:RYX_TxtUp)
(set_tile "ea02" PEACE:RYX_TxtDn)
(set_tile "ea03" (rtos PEACE:RYX_DIR 2 0))
(action_tile "ea04" "(GETDATAa)(SaveSysVar)(done_dialog 1)")
(action_tile "ea05" "(GETDATAa)(SaveSysVar)(done_dialog 2)")
(action_tile "ea06" "(GETDATAa)(SaveSysVar)(done_dialog 4)")
(setq bb (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
(if (= bb 2)
(progn
(setq dclname (cond
((setq tempname (vl-filename-mktemp "yx.dcl")
filen (open tempname "w")
)
(foreach stream '("\n" "yx1:dialog {\n"
" label = \"点筋引线标柱设置\" ;\n"
" :edit_box { label = \"文字高度\" ; key = \"e00\" ; }\n"
" :edit_box { label = \"宽度比例\" ; key = \"e01\" ; }\n"
" :edit_box { label = \"文字偏移\" ; key = \"e02\" ; }\n"
" :edit_box { label = \"文字颜色\" ; key = \"e03\" ; }\n"
" :edit_box { label = \"文字图层\" ; key = \"e04\" ; }\n"
" :edit_box { label = \"引线颜色\" ; key = \"e05\" ; }\n"
" :edit_box { label = \"引线图层\" ; key = \"e06\" ; }\n"
" :edit_box { label = \"出图比例\" ; key = \"e07\" ; }\n"
" :row { :button { key = \"e08\" ; label = \"确认\" ;is_default = true ; }\n"
" :button { key = \"e09\" ; label = \"默认\" ; }\n"
" :button { key = \"e10\" ; label = \"取消\" ; is_cancel = true ; } } }\n"
)
(princ stream filen)
)
(close filen)
tempname
)
)
)
(setq dcl_re (load_dialog dclname))
(if (not (new_dialog "yx1" dcl_re))
(exit)
)
(set_tile "e00" (rtos PEACE:RYX_TextH 2 2))
(set_tile "e01" (rtos PEACE:RYX_TextW2H 2 2))
(set_tile "e02" (rtos PEACE:RYX_TextD 2 2))
(set_tile "e03" (rtos PEACE:RYX_TextColor 2 0))
(set_tile "e04" PEACE:RYX_TextLayer)
(set_tile "e05" (rtos PEACE:RYX_DIMColor 2 0))
(set_tile "e06" PEACE:RYX_DIMLayer)
(set_tile "e07" (rtos PEACE:RYX_Ratio 2 0))
(action_tile "e08" "(GETDATA)(SaveSysVar)(done_dialog 3)")
(action_tile "e09" "(set_tile \"e00\" \"350\")(set_tile \"e01\" \"0.70\")(set_tile \"e02\" \"100\")(set_tile \"e03\" \"7\")(set_tile \"e04\" \"J-TEXT\")(set_tile \"e05\" \"7\")(set_tile \"e06\" \"J-THIN\")(set_tile \"e07\" \"100\")")
(action_tile "e10" "(done_dialog 3)")
(setq bb (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
)
)
)
(if (= bb 1)
(if (= PEACE:RYX_DIR 0)
(progn ;水平标注
(princ "\n>>> 选择点筋:")
(while(null(setq en (ssget (list'(0 . "*POLYLINE"))))))
(setq i 0)
(repeat (sslength en)
(setq end (ssname en i))
(setq end_data (entget end))
(if (= 2 (length (setq centerplsti (PEACE:Assoc_ItemList 10 end_data))))
(progn
(setq centerp (PEACE:Point_CenterPoint centerplsti nil))
(setq centerplst (cons centerp centerplst))
)
)
(setq i (1+ i))
)
(setq centerplst (Sort_pList centerplst "L->R" "U->D"))
(setq endplst (PEACE:PointList_OffsetPointYR centerplst 0 1.1))
(setq pt0 (nth 0 centerplst))
(princ (strcat "\n>>> 指定引线基线位置:"))
(setq i 0)
;画斜引线
(setq lineent '()
entname '()
)
(repeat (length centerplst)
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity")(cons 62 PEACE:RYX_DIMColor)(cons 8 PEACE:RYX_DIMLayer)'(100 . "AcDbLine")(cons 10 (nth i centerplst)) (cons 11 (nth i endplst))))
(setq lineent (cons (entget (entlast)) lineent)
entname (cons (entlast) entname)
)
(setq i (1+ i))
)
(setq lineent (reverse lineent))
;写上排文字
(entmake (list '(0 . "TEXT") (cons 62 PEACE:RYX_TextColor)(cons 8 PEACE:RYX_TextLayer)(cons 7 tstyle) (cons 1 PEACE:RYX_TxtUp) (cons 10 (nth 0 endplst)) (cons 40 (* bi PEACE:RYX_TextH))(cons 41 PEACE:RYX_TextW2H))
)
(setq textent1 (entget (entlast))
entname (cons (entlast) entname)
w1 (caadr (textbox textent1))
)
;写下排文字
(entmake (list '(0 . "TEXT") (cons 62 PEACE:RYX_TextColor)(cons 8 PEACE:RYX_TextLayer)(cons 7 tstyle) (cons 1 PEACE:RYX_TxtDn) (cons 10 (nth 0 endplst)) (cons 40 (* bi PEACE:RYX_TextH))(cons 41 PEACE:RYX_TextW2H))
)
(setq textent2 (entget (entlast))
entname (cons (entlast) entname)
w2 (caadr (textbox textent2))
)
(setq w (max w1 w2))
(setq w1 (- (car (nth (1- (length endplst)) endplst))(car (nth 0 endplst))))
(setq endp (list (+ (car (nth 0 endplst)) (+ w1 w (* bi 200)))
(cadr (nth 0 endplst))
))
;画水平引线
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 62 PEACE:RYX_DIMColor)(cons 8 PEACE:RYX_DIMLayer) '(100 . "AcDbLine")(cons 10 (nth 0 endplst)) (cons 11 endp)))
(setq lineent0 (entget (entlast))
entname (cons (entlast) entname)
)
(while
(progn
(setq gr (grread t 15 0)
code (car gr)
data (cadr gr)
)
(cond
((= code 3) ; 鼠标左击
(setq ptlast pt
xunh nil
)
)
((= code 5) ; 鼠标移动
(setq pt data)
(if (> (car pt) (car (nth 0 centerplst)))
(progn ;右侧
;更新斜引线
(setq endplst (PEACE:PointList_OffsetPointYR centerplst (cadr pt) (angle (nth 0 centerplst) pt)))
(setq endplstL2R (Sort_pList endplst "L->R" "U->D"))
(setq i 0)
(repeat (length centerplst)
(entmod (subst
(list 11 (car (nth i endplst)) (cadr (nth i endplst)))
(assoc 11 (nth i lineent))
(nth i lineent)
)
)
(setq i (1+ i))
)
;更新水平引线
(setq endp (list (+ (car (nth (1- (length endplstL2R)) endplstL2R)) (+ w (* bi 200)))
(cadr (nth (1- (length endplstL2R)) endplstL2R))
))
(setq lineent0
(entmod (subst
(list 10 (car (nth 0 endplstL2R)) (cadr (nth 0 endplstL2R)))
(assoc 10 lineent0)
lineent0
)
)
)
(entmod (subst
(list 11 (car endp) (cadr endp))
(assoc 11 lineent0)
lineent0
)
)
;更新上排文字
(setq textent1
(subst
(cons 72 2)
(assoc 72 textent1)
textent1
)
)
(setq textent1
(subst
(cons 73 1)
(assoc 73 textent1)
textent1
)
)
(entmod (subst
(list 11 (car endp) (+ (cadr endp) (* bi PEACE:RYX_TextD)))
(assoc 11 textent1)
textent1
)
)
;更新下排文字
(setq textent2
(subst
(cons 72 2)
(assoc 72 textent2)
textent2
)
)
(setq textent2
(subst
(cons 73 3)
(assoc 73 textent2)
textent2
)
)
(entmod (subst
(list 11 (car endp) (- (cadr endp) (* bi PEACE:RYX_TextD)))
(assoc 11 textent2)
textent2
)
)
)
(progn ;左侧
;更新斜引线
(setq endplst (PEACE:PointList_OffsetPointYL centerplst (cadr pt) (angle (nth 0 centerplst) pt)))
(setq endplstL2R (Sort_pList endplst "L->R" "U->D"))
(setq i 0)
(repeat (length centerplst)
(entmod (subst
(list 11 (car (nth i endplst)) (cadr (nth i endplst)))
(assoc 11 (nth i lineent))
(nth i lineent)
)
)
(setq i (1+ i))
)
;更新水平引线
(setq endp (list (- (car (nth 0 endplstL2R)) (+ w (* bi 200)))
(cadr (nth 0 endplstL2R))
))
(setq lineent0
(entmod (subst
(list 10 (car (nth (1- (length endplstL2R)) endplstL2R)) (cadr (nth (1- (length endplstL2R)) endplstL2R)))
(assoc 10 lineent0)
lineent0
)
)
)
(entmod (subst
(list 11 (car endp) (cadr endp))
(assoc 11 lineent0)
lineent0
)
)
;更新上排文字
(setq textent1
(subst
(cons 72 0)
(assoc 72 textent1)
textent1
)
)
(setq textent1
(subst
(cons 73 1)
(assoc 73 textent1)
textent1
)
)
(entmod (subst
(list 11 (car endp) (+ (cadr endp) (* bi PEACE:RYX_TextD)))
(assoc 11 textent1)
textent1
)
)
;更新下排文字
(setq textent2
(subst
(cons 72 0)
(assoc 72 textent2)
textent2
)
)
(setq textent2
(subst
(cons 73 3)
(assoc 73 textent2)
textent2
)
)
(entmod (subst
(list 11 (car endp) (- (cadr endp) (* bi PEACE:RYX_TextD)))
(assoc 11 textent2)
textent2
)
)
)
)
(redraw)
)
((or(= code 11)(= code 25)) ; 鼠标右击
;(entdel name1)
;(entdel name2)
(setq xunh nil)
(redraw)
)
(t
)
);ending cond
xunh
)
)
)
(progn ;竖直标注
(princ "\n>>> 选择点筋:")
(while(null(setq en (ssget (list'(0 . "*POLYLINE"))))))
(setq i 0)
(repeat (sslength en)
(setq end (ssname en i))
(setq end_data (entget end))
(if (= 2 (length (setq centerplsti (PEACE:Assoc_ItemList 10 end_data))))
(progn
(setq centerp (PEACE:Point_CenterPoint centerplsti nil))
(setq centerplst (cons centerp centerplst))
)
)
(setq i (1+ i))
)
(setq centerplst (Sort_pList centerplst"D->U" "L->R"))
(setq endplst (PEACE:PointList_OffsetPointXD centerplst 0 1.1))
(setq pt0 (nth 0 centerplst))
(princ (strcat "\n>>> 指定引线基线位置:"))
(setq i 0)
;画斜引线
(setq lineent '()
entname '()
)
(repeat (length centerplst)
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity")(cons 62 PEACE:RYX_DIMColor)(cons 8 PEACE:RYX_DIMLayer)'(100 . "AcDbLine")(cons 10 (nth i centerplst)) (cons 11 (nth i endplst))))
(setq lineent (cons (entget (entlast)) lineent)
entname (cons (entlast) entname)
)
(setq i (1+ i))
)
(setq lineent (reverse lineent))
;写上排文字
(entmake (list '(0 . "TEXT") (cons 62 PEACE:RYX_TextColor)(cons 8 PEACE:RYX_TextLayer)(cons 7 tstyle) (cons 1 PEACE:RYX_TxtUp) (cons 50 (/ pi 2)) (cons 10 (nth 0 endplst)) (cons 40 (* bi PEACE:RYX_TextH))(cons 41 PEACE:RYX_TextW2H))
)
(setq textent1 (entget (entlast))
entname (cons (entlast) entname)
w1 (caadr (textbox textent1))
)
;写下排文字
(entmake (list '(0 . "TEXT") (cons 62 PEACE:RYX_TextColor)(cons 8 PEACE:RYX_TextLayer)(cons 7 tstyle) (cons 1 PEACE:RYX_TxtDn) (cons 50 (/ pi 2)) (cons 10 (nth 0 endplst)) (cons 40 (* bi PEACE:RYX_TextH))(cons 41 PEACE:RYX_TextW2H))
)
(setq textent2 (entget (entlast))
entname (cons (entlast) entname)
w2 (caadr (textbox textent2))
)
(setq w (max w1 w2))
(setq endp (list (car (nth (1- (length endplst)) endplst))
(+ (cadr (nth (1- (length endplst)) endplst)) (+ w (* bi 200)))
))
;画水平引线
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 62 PEACE:RYX_DIMColor)(cons 8 PEACE:RYX_DIMLayer) '(100 . "AcDbLine")(cons 10 (nth 0 endplst)) (cons 11 endp)))
(setq lineent0 (entget (entlast))
entname (cons (entlast) entname)
)
(while
(progn
(setq gr (grread t 15 0)
code (car gr)
data (cadr gr)
)
(cond
((= code 3) ; 鼠标左击
(setq ptlast pt
xunh nil
)
)
((= code 5) ; 鼠标移动
(setq pt data)
(if (> (cadr pt) (cadr (nth 0 centerplst)))
(progn ;上侧
;更新斜引线
(setq endplst (PEACE:PointList_OffsetPointXU centerplst (car pt) (angle (nth 0 centerplst) pt)))
(setq endplstL2R (Sort_pList endplst "D->U" "L->R"))
(setq i 0)
(repeat (length centerplst)
(entmod (subst
(list 11 (car (nth i endplst)) (cadr (nth i endplst)))
(assoc 11 (nth i lineent))
(nth i lineent)
)
)
(setq i (1+ i))
)
;更新水平引线
(setq endp (PEACE:Point_Offset (nth (1- (length endplstL2R)) endplstL2R) 0 (+ w (* bi 200)) 0))
(setq lineent0
(subst
(list 10 (car (nth 0 endplstL2R)) (cadr (nth 0 endplstL2R)))
(assoc 10 lineent0)
lineent0
)
)
(entmod (subst
(list 11 (car endp) (cadr endp))
(assoc 11 lineent0)
lineent0
)
)
;更新上排文字
(setq textent1
(subst
(cons 72 2)
(assoc 72 textent1)
textent1
)
)
(setq textent1
(subst
(cons 73 1)
(assoc 73 textent1)
textent1
)
)
(entmod (subst
(list 11 (- (car endp) (* bi PEACE:RYX_TextD)) (cadr endp))
(assoc 11 textent1)
textent1
)
)
;更新下排文字
(setq textent2
(subst
(cons 72 2)
(assoc 72 textent2)
textent2
)
)
(setq textent2
(subst
(cons 73 3)
(assoc 73 textent2)
textent2
)
)
(entmod (subst
(list 11 (+ (car endp) (* bi PEACE:RYX_TextD)) (cadr endp))
(assoc 11 textent2)
textent2
)
)
)
(progn ;下侧
;更新斜引线
(setq endplst (PEACE:PointList_OffsetPointXD centerplst (car pt) (angle (nth 0 centerplst) pt)))
(setq endplstL2R (Sort_pList endplst "D->U" "L->R"))
(setq i 0)
(repeat (length centerplst)
(entmod (subst
(list 11 (car (nth i endplst)) (cadr (nth i endplst)))
(assoc 11 (nth i lineent))
(nth i lineent)
)
)
(setq i (1+ i))
)
;更新水平引线
(setq endp (PEACE:Point_Offset (nth 0 endplstL2R) 0 (- (+ w (* bi 200))) 0))
(setq lineent0
(subst
(list 10 (car (nth (1- (length endplstL2R)) endplstL2R)) (cadr (nth (1- (length endplstL2R)) endplstL2R)))
(assoc 10 lineent0)
lineent0
)
)
(entmod (subst
(list 11 (car endp) (cadr endp))
(assoc 11 lineent0)
lineent0
)
)
;更新上排文字
(setq textent1
(subst
(cons 72 0)
(assoc 72 textent1)
textent1
)
)
(setq textent1
(subst
(cons 73 1)
(assoc 73 textent1)
textent1
)
)
(entmod (subst
(list 11 (- (car endp) (* bi PEACE:RYX_TextD)) (cadr endp))
(assoc 11 textent1)
textent1
)
)
;更新下排文字
(setq textent2
(subst
(cons 72 0)
(assoc 72 textent2)
textent2
)
)
(setq textent2
(subst
(cons 73 3)
(assoc 73 textent2)
textent2
)
)
(entmod (subst
(list 11 (+ (car endp) (* bi PEACE:RYX_TextD)) (cadr endp))
(assoc 11 textent2)
textent2
)
)
)
)
(redraw)
)
((or(= code 11)(= code 25)) ; 鼠标右击
;(entdel name1)
;(entdel name2)
(setq xunh nil)
(redraw)
)
(t
)
);ending cond
xunh
)
)
)
)
)
(command ".UNDO" "E")
(setq *error* $orr)
(princ "\n***点筋引线绘制完成! ")
(PEACE:RestoreSysVar) ;还原系统变量
(princ)
)
(princ)
langjs 发表于 2013-8-16 22:03 static/image/common/back.gif
稍微修改一下，解决楼上一半概率问题
这样，岂不是在交点处，两条相交线段都被打断了，要是只打断其中一个呢？ 学习一下？。。。
页:
[1]