无聊，dmex ==延伸反转dim尺寸界线源码

狂刀lxx · 发表于 2011-5-10 23:51:15

一个很老很老的程序.... 想当年还没谈女朋友，极度无聊发狂....

;;***+ dmex ==延伸反转dim尺寸界线－v3－－－－－lxx.2002.11(2009.7.21v3)
;;用于调整 e13 e14 特征点
;;本程序可以达到与dmtr尺寸延伸线裁减一样的效果，并且不依赖与是否相交
;;v1.0 1999.2 v2.0 2002.11
;;v2.0 更改计算方法；dime取消，改名为dmex；加入对linear,rotated!,align的判定
;;;下列组码适用于线性和转角标注。
;;;组码说明
;;;50 转角、水平和垂直标注的角度。
;;;52 具有倾斜角度的线性标注类型有可选组码 52。当增加线性标注的旋转角（组码 50）时，组码 52 给出延长线的角度。
;;;100 子类标记 (AcDbRotatedDimension)
;;;对于alinged,p14->p13角度总是与标注线角度同.
;70 标注类型：整数值 0 - 6 表示标注类型。位值 32、64 和 128 则添加到整数值后（在 R13 和更高版本中设置值 32）。0 = 转角标注、水平标注或垂直标注；1 = 对;;齐标注；2 = 角度标注；3 = 直径标注；4 = 半径标注；5 = 角度三点标注；6 = 坐标标注；32 = 表示块引用（组码 2）只被此标注引用；64 = 坐标标注类型，此位值（位 ;7）只与类型 6 一起使用，如果设置，坐标类型为 X 型，否则为 Y 型；128 = 如果标注文本位于用户指定的位置而不是缺省位置，此位值（位 7）将添加到其他的组码 70 ;的;值中。
;;图示:
;; +---+ >> +----+e10
;; |e13 |e14
;;-------------------------------------------dmex-------------------------------------;;;
(princ "\ndmex ==延伸反转dim尺寸界线－v3－lxx.200211,200907\n")
;;
(defun c:dmex (/ ANG ANGP DISTEX E E10 E13 E14 ENT I NE13 NE14 PP= SS
gr wkey2)
(princ
"\ndmex ==延伸反转dim尺寸界线－v3－lxx.200211,200907\n"
)
;;
(vl-load-com)
(initget "W")
(setq *doc (vla-get-activedocument (setq *cad (vlax-get-acad-object)))
distex (getdist "\n 尺寸界线延伸长度/<延伸线反转>:")
)
;;
(while (progn (setq i 0)
(princ "\n W-反转上一选集/<退出>/选择标注:")
(setq gr (grread nil 4 2))
(cond
((member gr '((11 0) (2 13))) nil)
((member (cadr gr) '(119 87))
(setq ss (ssget "P")
wkey2 T
)
) ;"wW"
((= 3 (car gr))
(progn
(setq p (cadr gr)
p$ (strcat """
(rtos (car p) 2 4)
","
(rtos (cadr p) 2 4)
"""
)
)
(setq ss(ssget (list(cons(progn(vla-eval *cad(strcat "thisdrawing.sendcommand " p$ " &VBCR"))0) "DIMENSION"))))
(grread 4 2)
;(setq ss(ssget (list(cons(progn(vla-eval *cad(strcat "thisdrawing.sendcommand " p$ " &VBCR"))0) "DIMENSION"))))
)
)
)
)
(repeat (sslength ss)
(setq ent (ssname ss i)
e (entget ent)
e10 (cdr (assoc 10 e))
e13 (cdr (assoc 13 e))
e14 (cdr (assoc 14 e))
pp= (equal e10 e14 1e-4)
)
(if (member '(100 . "AcDbRotatedDimension") e)
;;!!!用子类标记准确, !!!!用70判定不准,转角平直标注可能=0,32...
(setq ang (cdr (assoc 50 e))
angp (if pp=
(+ (/ PI 2) ang)
(angle e10 e14)
)
)
(setq ang (angle e13 e14)
angp (if pp=
(+ (/ PI 2) ang)
(angle e10 e14)
)
)
)
;;; 延伸线反转
(if wkey2
(setq distex (distance e10 e14)
angp (+ PI angp)
)
)
(setq ne14 (polar e10 angp distex)
ne13 (inters e13
(polar e13 angp 100)
ne14
(polar ne14 ang 100)
nil
)
i (1+ i)
)
(setq e (subst (cons 13 ne13) (assoc 13 e) e)
e (subst (cons 14 ne14) (assoc 14 e) e)
)
(entmod e)
(entupd ent)
)
(setq wkey2 nil)
)
(princ)
)

;;***+ dmex ==延伸反转dim尺寸界线－v3－－－－－lxx.2002.11(2009.7.21v3) 
;;用于调整 e13 e14 特征点 
;;本程序可以达到与dmtr尺寸延伸线裁减一样的效果，并且不依赖与是否相交 
;;v1.0 1999.2 v2.0 2002.11 
;;v2.0 更改计算方法；dime取消，改名为dmex；加入对linear,rotated!,align的判定 
;;;下列组码适用于线性和转角标注。 
;;;组码 说明 
;;;50 转角、水平和垂直标注的角度。 
;;;52 具有倾斜角度的线性标注类型有可选组码 52。当增加线性标注的旋转角（组码 50）时，组码 52 给出延长线的角度。 
;;;100 子类标记 (AcDbRotatedDimension) 
;;;对于alinged,p14->p13角度总是与标注线角度同. 
;70   标注类型：整数值 0 - 6 表示标注类型。位值 32、64 和 128 则添加到整数值后（在 R13 和更高版本中设置值 32）。0 = 转角标注、水平标注或垂直标注；1 = 对;;齐标注；2 = 角度标注；3 = 直径标注；4 = 半径标注；5 = 角度三点标注；6 = 坐标标注；32 = 表示块引用（组码 2）只被此标注引用；64 = 坐标标注类型，此位值（位 ;7）只与类型 6 一起使用，如果设置，坐标类型为 X 型，否则为 Y 型；128 = 如果标注文本位于用户指定的位置而不是缺省位置，此位值（位 7）将添加到其他的组码 70 ;的;值中。 
;;图示: 
;;  +---+  >>  +----+e10 
;;             |e13 |e14 
;;-------------------------------------------dmex-------------------------------------;;; 
(princ "\ndmex ==延伸反转dim尺寸界线－v3－lxx.200211,200907\n") 
;; 
(defun c:dmex (/ ANG ANGP DISTEX E E10 E13 E14 ENT I NE13 NE14 PP= SS 
        gr wkey2) 
  (princ 
    "\ndmex ==延伸反转dim尺寸界线－v3－lxx.200211,200907\n" 
  ) 
  ;; 
  (vl-load-com) 
  (initget "W") 
  (setq *doc   (vla-get-activedocument (setq *cad (vlax-get-acad-object))) 
 distex (getdist "\n 尺寸界线延伸长度/<延伸线反转>:") 
  ) 
  ;; 
  (while (progn (setq i 0) 
  (princ "\n W-反转上一选集/<退出>/选择标注:") 
  (setq gr (grread nil 4 2)) 
  (cond 
    ((member gr '((11 0) (2 13))) nil) 
    ((member (cadr gr) '(119 87)) 
     (setq ss    (ssget "P") 
    wkey2 T 
     ) 
    )   ;"wW" 
    ((= 3 (car gr)) 
     (progn 
       (setq p (cadr gr) 
      p$ (strcat """ 
          (rtos (car p) 2 4) 
          "," 
          (rtos (cadr p) 2 4) 
          """ 
         ) 
       ) 
       (setq ss(ssget (list(cons(progn(vla-eval *cad(strcat "thisdrawing.sendcommand " p$ " &VBCR"))0) "DIMENSION")))) 
       (grread 4 2) 
       ;(setq ss(ssget (list(cons(progn(vla-eval *cad(strcat "thisdrawing.sendcommand " p$ " &VBCR"))0) "DIMENSION")))) 
     ) 
    ) 
  ) 
  ) 
    (repeat (sslength ss) 
   (setq ent (ssname ss i) 
  e   (entget ent) 
  e10 (cdr (assoc 10 e)) 
  e13 (cdr (assoc 13 e)) 
  e14 (cdr (assoc 14 e)) 
  pp= (equal e10 e14 1e-4) 
   ) 
   (if (member '(100 . "AcDbRotatedDimension") e) 
     ;;!!!用子类标记准确, !!!!用70判定 不准,转角平直标注可能=0,32... 
     (setq ang  (cdr (assoc 50 e)) 
    angp (if pp= 
    (+ (/ PI 2) ang) 
    (angle e10 e14) 
         ) 
     ) 
     (setq ang  (angle e13 e14) 
    angp (if pp= 
    (+ (/ PI 2) ang) 
    (angle e10 e14) 
         ) 
     ) 
   ) 
;;; 延伸线反转 
   (if  wkey2 
     (setq distex (distance e10 e14) 
    angp  (+ PI angp) 
     ) 
   ) 
   (setq ne14 (polar e10 angp distex) 
  ne13 (inters e13 
        (polar e13 angp 100) 
        ne14 
        (polar ne14 ang 100) 
        nil 
       ) 
  i    (1+ i) 
   ) 
   (setq e (subst (cons 13 ne13) (assoc 13 e) e) 
  e (subst (cons 14 ne14) (assoc 14 e) e) 
   ) 
   (entmod e) 
   (entupd ent) 
 ) 
    (setq wkey2 nil) 
  ) 
  (princ) 
)

461045462 · 发表于 2011-5-11 09:15:10

谢谢楼主的分享
收藏了,下来学习领会
谢谢

xjf · 发表于 2011-5-11 12:27:53

好代码，支持开源

yxl88168 · 发表于 2011-5-11 17:48:49

谢谢楼主分享

yshf · 发表于 2011-5-11 23:21:45

是啊，你的程序太好了，支持楼主！

coco25825 · 发表于 2011-6-3 19:08:38

的确很无聊的程序

pop159 · 发表于 2012-10-14 15:18:48

你的程序太好了

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

无聊，dmex ==延伸反转dim尺寸界线 源码

无聊，dmex ==延伸反转dim尺寸界线源码