请问这个自动标注用lisp怎么写

小师傅 · 发表于 2014-6-29 22:48:32

请问框选任意角度排列的N多彼此平行的直线，就能一次性自动标注出各直线间的距离，用lisp要怎么写

fl202 · 发表于 2014-6-29 22:48:33

转

(defun C:TT (/ A ANG B DIMSTYLE E E1 ENTL
ELIST MPT MPT1 P1 P2 PT PT1 PT2 PTI
PTS SS V10
)
(setvar "cmdecho" 0)
(setq DIMSTYLE (getvar "dimstyle")) ; _标注样式，可以修改成自己需要的
(if (and (setq PT1 (getpoint "\n点取【逐点标注】起始点<退出>："))
(setq PT2 (getpoint PT1 "结束点<退出>："))
(setq SS (ssget "c" PT1 PT2 '((0 . "LINE"))))
)
(progn
;;1.
;;标注的角度ang按第一条线来定,省去了过滤角度不一样的线,
;;其实是我觉得太麻烦了,手上又没有通用函数。偷懒了。呵呵
(setq E1 (ssname SS 0))
(setq P1 (CJW-DXF E1 10))
(setq P2 (CJW-DXF E1 11))
(setq ANG (angle P1 P2))
(princ "\n选择不需要标注的线<无>:")
(command "._select"
SS
"r"
PAUSE
)
(if (setq SS (ssget "_P"))
(progn
;;2.
;;计算标注基点们pts的位置
(setq MPT (CJW-PT-MID PT1 PT2))
(setq PTS
(mapcar '(lambda (E)
(setq P1 (CJW-DXF E 10))
(setq P2 (CJW-DXF E 11))
(setq MPT1 (polar MPT (+ (* 0.5 pi) ANG) 1))
(inters MPT1 MPT P1 P2 NIL)
)
(CJW-SS->ENAMES SS)
)
)
(setq PTS (CJW-SORT-PTBYDIS PT1 PTS)) ;_点排序
(setq PTS (mapcar 'list PTS (cdr PTS))) ;_生成标注基点表
(if (setq PT (getpoint MPT "\n点取尺寸线的位置<原位标注>："))
(setq PT PT)
(setq PT MPT)
)
;;3.
;;标注的结果在此:
(foreach P PTS
(command "._dimlinear"
"none"
(car P)
"none"
(cadr P)
"none"
PT
)
(setq ENTL (entlast))
(setq ELIST (entget ENTL))
(setq V10 (cdr (assoc 10 ELIST)))
;;标注对齐点
(setq PTI (inters
PT
(polar PT (+ ANG (* 0.5 pi)) 1)
V10
(polar V10 ANG 1)
NIL
)
)
(setq ELIST (subst (cons 3 DIMSTYLE)
(assoc 3 ELIST)
ELIST
)
) ;_修改文字样式
(setq ELIST (subst (cons 10 PTI)
(assoc 10 ELIST)
ELIST
)
) ;_修改标注对齐点
(setq ELIST (subst (cons 50 (+ (* 0.5 pi) ANG))
(assoc 50 ELIST)
ELIST
)
) ;_修改标注角度
(entmod ELIST)
) ;_foreach
) ;_ss progn
) ;_ss if
) ;_and progn
) ;_and if
(princ)
)
;;;(CJW-PT-MID PT1 PT2)
(defun CJW-PT-MID (A B)
(mapcar
'(lambda (A B) (* (+ A B) 0.5))
A
B
)
)
;;;(CJW-SS->ENAMES (ssget))
(defun CJW-SS->ENAMES (SS / ENAMES)
(setq I 0)
(while (< I (sslength SS))
(setq ENAMES (cons (ssname SS I) ENAMES))
(setq I (1+ I))
)
(reverse ENAMES)
)
;;;(CJW-DXF (car (entsel)) 0)
(defun CJW-DXF (ENAME ITEM)
(cdr (assoc ITEM (entget ENAME)))
)
;;;(CJW-SORT-PTBYDIS PT PTS)
(defun CJW-SORT-PTBYDIS (PT PTS / COMS DISTS SORTS X Y)
(setq DISTS (mapcar
'(lambda (X)
(distance X PT)
)
PTS
)
)
(setq COMS (mapcar
'(lambda (X Y)
(list X Y)
)
DISTS
PTS
)
)
(setq SORTS (mapcar
'cadr
(vl-sort COMS
'(lambda (X Y)
(if (equal (car X) (car Y) 1e-10)
(<= (car (cadr X)) (car (cadr Y)))
(< (car X) (car Y))
)
)
)
)
)
SORTS
)
(princ)

(defun C:TT (/           A         ANG   B     DIMSTYLE         E     E1    ENTL 
             ELIST MPT         MPT1  P1    P2           PT         PT1   PT2   PTI 
             PTS   SS         V10 
            ) 
  (setvar "cmdecho" 0) 
  (setq DIMSTYLE (getvar "dimstyle"))        ; _标注样式，可以修改成自己需要的 
  (if (and (setq PT1 (getpoint "\n点取【逐点标注】起始点<退出>：")) 
           (setq PT2 (getpoint PT1 "结束点<退出>：")) 
           (setq SS (ssget "c" PT1 PT2 '((0 . "LINE")))) 
      ) 
    (progn 
      ;;1. 
      ;;标注的角度ang按第一条线来定,省去了过滤角度不一样的线, 
      ;;其实是我觉得太麻烦了,手上又没有通用函数。偷懒了。呵呵 
      (setq E1 (ssname SS 0)) 
      (setq P1 (CJW-DXF E1 10)) 
      (setq P2 (CJW-DXF E1 11)) 
      (setq ANG (angle P1 P2)) 
 
 
      (princ "\n选择不需要标注的线<无>:") 
      (command "._select" 
               SS 
               "r" 
               PAUSE 
      ) 
 
      (if (setq SS (ssget "_P")) 
        (progn 
          ;;2. 
          ;;计算标注基点们pts的位置 
          (setq MPT (CJW-PT-MID PT1 PT2)) 
          (setq        PTS 
                 (mapcar '(lambda (E) 
                            (setq P1 (CJW-DXF E 10)) 
                            (setq P2 (CJW-DXF E 11)) 
                            (setq MPT1 (polar MPT (+ (* 0.5 pi) ANG) 1)) 
                            (inters MPT1 MPT P1 P2 NIL) 
                          ) 
                         (CJW-SS->ENAMES SS) 
                 ) 
          ) 
          (setq PTS (CJW-SORT-PTBYDIS PT1 PTS)) ;_点排序 
          (setq PTS (mapcar 'list PTS (cdr PTS))) ;_生成标注基点表 
 
          (if (setq PT (getpoint MPT "\n点取尺寸线的位置<原位标注>：")) 
            (setq PT PT) 
            (setq PT MPT) 
          ) 
 
          ;;3. 
          ;;标注的结果在此: 
          (foreach P PTS 
            (command "._dimlinear" 
                     "none" 
                     (car P) 
                     "none" 
                     (cadr P) 
                     "none" 
                     PT 
            ) 
            (setq ENTL (entlast)) 
            (setq ELIST (entget ENTL)) 
            (setq V10 (cdr (assoc 10 ELIST))) 
 
            ;;标注对齐点 
            (setq PTI (inters 
                        PT 
                        (polar PT (+ ANG (* 0.5 pi)) 1) 
                        V10 
                        (polar V10 ANG 1) 
                        NIL 
                      ) 
            ) 
 
            (setq ELIST        (subst (cons 3 DIMSTYLE) 
                               (assoc 3 ELIST) 
                               ELIST 
                        ) 
            ) ;_修改文字样式 
            (setq ELIST        (subst (cons 10 PTI) 
                               (assoc 10 ELIST) 
                               ELIST 
                        ) 
            ) ;_修改标注对齐点 
            (setq ELIST        (subst (cons 50 (+ (* 0.5 pi) ANG)) 
                               (assoc 50 ELIST) 
                               ELIST 
                        ) 
            ) ;_修改标注角度 
 
            (entmod ELIST) 
 
          ) ;_foreach 
 
        ) ;_ss progn 
      ) ;_ss if 
 
    ) ;_and progn 
  ) ;_and if 
  (princ) 
) 
 
;;;(CJW-PT-MID PT1 PT2) 
(defun CJW-PT-MID (A B) 
  (mapcar 
    '(lambda (A B) (* (+ A B) 0.5)) 
    A 
    B 
  ) 
) 
 
;;;(CJW-SS->ENAMES (ssget)) 
(defun CJW-SS->ENAMES (SS / ENAMES) 
  (setq I 0) 
  (while (
    (setq ENAMES (cons (ssname SS I) ENAMES)) 
    (setq I (1+ I)) 
  ) 
  (reverse ENAMES) 
) 
 
;;;(CJW-DXF (car (entsel)) 0) 
(defun CJW-DXF (ENAME ITEM) 
  (cdr (assoc ITEM (entget ENAME))) 
) 
 
;;;(CJW-SORT-PTBYDIS PT PTS) 
(defun CJW-SORT-PTBYDIS        (PT PTS / COMS DISTS SORTS X Y) 
  (setq        DISTS (mapcar 
                '(lambda (X) 
                   (distance X PT) 
                 ) 
                PTS 
              ) 
  ) 
  (setq        COMS (mapcar 
               '(lambda        (X Y) 
                  (list X Y) 
                ) 
               DISTS 
               PTS 
             ) 
  ) 
  (setq        SORTS (mapcar 
                'cadr 
                (vl-sort COMS 
                         '(lambda (X Y) 
                            (if        (equal (car X) (car Y) 1e-10) 
                              (<= (car (cadr X)) (car (cadr Y))) 
                              (< (car X) (car Y)) 
                            ) 
                          ) 
                ) 
              ) 
  ) 
  SORTS 
) 
 
(princ)

ZZXXQQ · 发表于 2014-6-30 07:57:13

1、框选直线；
2、循环取得直线的坐标点，并计算出角度；
3、按角度分类后按坐标排序；
4、按顺序标注直线距离。

小师傅 · 发表于 2014-7-1 08:09:18

ZZXXQQ 发表于 2014-6-30 07:57
1、框选直线；
2、循环取得直线的坐标点，并计算出角度；
3、按角度分类后按坐标排序；

Z版能不能帮忙写一个呀

xyp1964 · 发表于 2014-7-1 12:42:47

AMTONNY · 发表于 2014-7-5 00:20:23

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

[提问] 请问这个自动标注用lisp怎么写

最佳答案

本帖子中包含更多资源

浏览过的版块