多点打断

958620832 · 发表于 2013-8-16 16:10:46

(defun c:br ()
(setq ent (car (entsel "\n请选择被打断线段:")))
(while (setq p (getpoint "\n请选择断点:"))
(command "_.break" ent p "@"))
(princ))
用途：实现线段的多点打断
实现不了，不知道问题出在了什么地方，高手求助

ll_j · 发表于 2013-8-16 16:48:36

(defun c:br1 ()
(setq ent (entsel "\n请选择被打断线段:"))
(while (setq p (getpoint "\n请选择断点:"))
(command "_.break" ent "F" p "@")
)
(princ)
)

这段程序只能有50%概率能连续打断，这是因为线条打断后，变成两个实体，只有一半的概率打断点位于早先拾取实体名上。

langjs · 发表于 2013-8-16 22:03:13

本帖最后由 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)
)

958620832 · 发表于 2013-8-17 19:59:14

langjs 发表于 2013-8-16 22:03
稍微修改一下，解决楼上一半概率问题

(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))
(setq  Alist (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得到pt2  by 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)

958620832 · 发表于 2013-9-24 15:11:10

langjs 发表于 2013-8-16 22:03
稍微修改一下，解决楼上一半概率问题

这样，岂不是在交点处，两条相交线段都被打断了，要是只打断其中一个呢？

hooboxu · 发表于 2014-11-4 23:45:39

学习一下？。。。

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

[提问] 多点打断

相关帖子

本帖子中包含更多资源