请教一下wowan1314老师的逐点标注怎样调整为限制垂直水平标注？

hooboxu 发表于 2014-12-10 02:39:48

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=101084

也就是cad命令的dli.和dal区别。

hooboxu 发表于 2014-12-11 00:44:49

;;;模仿天正逐点标注BY---WOWAN1314
(PRINC "\n逐点标注程序BY--WOWAN1314; 启动命令YY-ZDBZ")
(defun c:ddd ( / pt1 pt2 NAME P1 P2 PT3 PT3-1 ANGDU LOOP CODE PT10 NAME0 oldosmode PT_LST PT_LST1 NAME1 tx_start tx_END tx_error zctbz last_ent)

(defun tx_start ( / )
(setq old_err *error* *error* tx_error)
(command ".UNDO" "BE")
(princ)
)
(defun tx_end ( / tt )
(setq *error* old_err)
(command ".UNDO" "E")
(princ)
)
(defun tx_error (s)
(PRINC "\n程序被终止")
(tx_end)
)

(defun zctbz (name PTS / ds ent pt10 pt14 pts) ; 更新标注
(setq ent (entget name)
   pt10 (cdr (assoc 10 ent))
   pt14 (cdr (assoc 14 ent))
   ds (angle pt14 pt10)
)
(entmod (subst
      (cons 10 pts)
      (assoc 10 ent)
      ent
   )
)
)
(defun last_ent (en / ss);EN后选择集
(if en
(progn
   (setq ss (ssadd))
   (while (setq en (entnext en))
      (if (not (member (cdr (assoc 0 (entget en)))
                     '("ATTRIB" "VERTEX" "SEQEND")
               )
         )
      (ssadd en ss)
      );if
   );while
   (if (zerop (sslength ss)) (setq ss nil))
   ss
);progn
(ssget "_x")
);if
)
(tx_start)
(SETQ P1 (GETPOINT "\n指定标注第一点:") P2 (GETPOINT P1 "\n指定标注第二点:"))
(SETQ NAME0 (ENTLAST))
(entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 p2) '(70 . 33) '(1 . "") '
   (100 . "AcDbAlignedDimension") (cons 13 (TRANS p1 1 0)) (cons 14 (TRANS p2 1 0))
      )
)
(SETQ NAME(ENTLAST) loop T)
(PRINC "\n点取标注线位置:")
(while loop
(setq code (grread T 8))
(cond
((= (car code) 5) (zctbz NAME (SETQ PT10(TRANS (CADR CODE) 1 0))))
((= (car code) 3) (SETQ LOOP NIL))
)
)
(SETQ ANGDU (+ (* 0.5 pi) (anglep1 p2)))
(SETQ PT_LST (LIST P1 P2) pt2 p2 PT10 (TRANS PT10 0 1))
(PRINC "\n指定标注下一点:")
(WHILE
(SETQ PT3 (GETPOINT PT2) PT2 PT3) ;;PT2保存下这次选择点
(setq pt3-1 (polar pT3 ANGDU 2))
(setq pt3 (inters pT3 pt3-1 p1 p2 nil));;PT3为要标的点
(SETQ PT_LST (CONS PT3 PT_LST));;更新标注点表
(SETQ PT_LST (vl-sort PT_LST (function (lambda (e1 e2) (< (car e1) (car e2))))))
(SETQ PT_LST (vl-sort PT_LST (function (lambda (e1 e2) (< (caDr e1) (caDr e2))))))
(command "eRASE" (last_ent NAME0) "")
(SETQPT_LST1PT_LST)
(setq oldosmode (getvar "osmode") NAME1(ENTLAST))
(setvar "osmode" 0)
(repeat (1- (length pt_lst1));;重复点数-1此标注
   (if (>= (distance (CAR pT_LST1) (CADR pT_LST1)) 0.01)
   (progn
   (COMMAND "_DIMLINEAR" (CAR pT_LST1) (CADR pT_LST1) PT10)
   (SETQ PT_LST1 (CDR PT_LST1))
   )
   (SETQ PT_LST1 (CDR PT_LST1)))
)
(command "ucs" "W")
(yad_dimad1 (last_ent NAME1))
(command "ucs" "P")
(setvar "osmode" oldosmode)
);END WHILE

(tx_end)
(PRINC)
)

;;尺寸文字避让函数---------BY YAD
(defun yad_dimad1 (SS / yad-dxf yad-perpt yad-chgent ss n m ent en ang w h l_dat l_mov oldang mov s pt pt1 pt2 l_adj en l_en disang disw dish item item1)
(defun yad-dxf(en n)
(if (not (listp en)) (setq en (entget en)))
(cdr (assoc n en))
)
(defun yad-perpt(pt pt1 pt2)
(inters pt1 pt2 pt (polar pt (+ (angle pt1 pt2) (/ pi 2)) 1200) nil)
)
(defun yad-chgent(en n / m val)
(if (not (listp en)) (setq en (entget en)))
(foreach itm n
   (setq m (car itm) val (cadr itm))
   (if (assoc m en)
   (setq en (subst (cons m val) (assoc m en) en))
   (setq en (append en (list (cons m val))))
   )
)
(entmod en)
)
;(prompt "\n选择需要自动调整文字位置的一组标注尺寸：")
(if SS
(progn
; (vl-cmdf "_undo" "_be")
   (vl-cmdf "_.dimedit" "_h" ss "")
   (setq n -1 m 0)
   (repeat (sslength ss)
   (setq ent (ssname ss (setq n (1+ n))))
   (setq en (yad-dxf (tblsearch "block" (yad-dxf ent 2)) -2))
   (while (/= (yad-dxf (setq en (entnext en)) 0) "MTEXT"))
   (setq ang (yad-dxf en 50) h (yad-dxf en 43) w (+ (/ (yad-dxf en 42) 2) (* 0.2 h)) h (* 0.6 h))
   (setq l_dat (cons (list ent ang w h) l_dat))
   (if (< (/ (yad-dxf ent 42) 2) w)
      (if (= (rem (setq m (1+ m)) 2) 0)
         (setq l_mov (cons (list ent ang w h) l_mov))
         (setq l_mov (append l_mov (list (list ent ang w h))))
      )
   )
   )
   (foreach itm l_mov
   (setq ent (car itm) ang (cadr itm) w (caddr itm) h (cadddr itm) pt (yad-dxf ent 11) oldang (angle pt (yad-perpt pt (setq pt1 (yad-dxf ent 10)) (polar pt1 ang 1200))) mov T)
   (while (and mov (setq s (ssget "_f" (list (setq pt1 (polar (polar pt ang w) (+ ang (/ pi 2)) h)) (setq pt2 (polar pt1 (+ ang pi) (* 2 w))) (setq pt2 (polar pt2 (- ang (/ pi 2)) (* 2 h))) (polar pt2 ang (* 2 w)) pt1)
                                       '((0 . "dimension")(-4 . "<or")(70 . 0)(70 . 1)(70 . 32)(70 . 33)(70 . 128)(70 . 129)(70 . 160)(70 . 161)(-4 . "or>"))
                           )))
      (setq n -1 l_adj nil)
      (repeat (sslength s)
         (setq en (ssname s (setq n (1+ n))))
         (if (and (ssmemb en ss) (not (equal en ent)) (setq l_en (yad-dxf l_dat en)) (equal ang (car l_en) 0.01))
         (progn
            (setq pt1 (yad-perpt (yad-dxf en 11) pt (polar pt ang 1200))
                  disang (angle pt1 pt)
                  disw (- (+ w (cadr l_en)) (distance pt pt1))
                  dish (- (+ h (caddr l_en)) (distance pt (yad-perpt (yad-dxf en 11) pt (polar pt (+ ang (/ pi 2)) 1200))))
            )
            (if (and (> dish 0) (not (equal dish 0 1)))
               (if (setq item (vl-member-if '(lambda(e) (equal (car e) disang 0.01)) l_adj))
               (setq item (car item) l_adj (subst (list disang (max disw (cadr item)) (max dish (caddr item))) item l_adj))
               (setq l_adj (cons (list disang disw dish) l_adj))
               )
            )
         )
         )
      )
      (cond
         ((not l_adj) (setq mov nil))
         ((and (= (length l_adj) 1) (setq item (car l_adj)) (> (setq disw (cadr item)) 0) (not (equal disw 0 1)) (> (caddr item) 0))
         (if (> (yad-dxf ent 70) 128)
            (progn
               (setq pt1 (yad-perpt pt (setq pt2 (yad-dxf ent 10)) (polar pt2 ang 1200)))
               (yad-chgent ent (list (list 11 (setq pt (polar pt (setq disang (angle pt pt1)) (* 2 (+ (distance pt pt1) (if (equal disang oldang 0.01) 0 h)))))) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))
            )
            (progn
               (setq mov nil)
               (yad-chgent ent (list (list 11 (polar pt (car item) disw)) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))
            )
         )
         )
         ((and (= (length l_adj) 2) (setq item (car l_adj) item1 (cadr l_adj))
               (or (and (> (setq disw (cadr item)) 0) (not (equal disw 0 1)) (> (caddr item) 0))
                  (and (> (setq disw (cadr item1)) 0) (not (equal disw 0 1)) (> (caddr item1) 0))
               ))
         (if (or (> (yad-dxf ent 70) 128) (and (> (caddr item) 0) (> (caddr item1) 0) (> (setq disw (+ (cadr item) (cadr item1))) 0) (not (equal disw 0 1))))
            (progn
               (setq pt1 (yad-perpt pt (setq pt2 (yad-dxf ent 10)) (polar pt2 ang 1200)))
               (if (equal pt pt1 1) (setq disang (- ang (/ pi 2))) (setq disang (angle pt pt1)))
               (yad-chgent ent (list (list 11 (setq pt (polar pt disang (* 2 (+ (distance pt pt1) (if (equal disang oldang 0.01) 0 h)))))) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))
            )
            (progn
               (setq mov nil)
               (if (or (< (caddr item) 0) (and (< (setq disw (cadr item)) 0) (not (equal disw 0 1))))
               (setq item item1)
               )
               (yad-chgent ent (list (list 11 (polar pt (car item) (cadr item))) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))
            )
         )
         )
         (T (setq mov nil))
      )
   )
   )
   ;(prompt "\n自动调整完毕！")
; (vl-cmdf "_undo" "_e")
)
)
(princ)
)

以上代码已经把
DIMALIGNED 已经改了 DIMLINEAR ,但还是有问题.有大大指导一下.或帮忙调试一下吗?感激不尽.

hooboxu 发表于 2014-12-12 00:42:59

有人知道吗？我表达的意思大家知道吗

鱼与熊掌 发表于 2014-12-13 16:03:16

参照组码 31 32 33 33是倾斜

hooboxu 发表于 2014-12-13 17:57:42

谢谢鱼与熊掌指教，我去改改看。谢谢

hooboxu 发表于 2014-12-14 01:02:43

还是整不出来。。。。

页: [1]

明经CAD社区's Archiver

请教一下wowan1314老师的逐点标注怎样调整为限制垂直水平标注？