各位高手求助看下这个程序如何修改！！！（如何让标注的界址点号从西北角开始顺时...

lhngxy

(defun err(msg)
   (princ msg);"*cancel*")
   (restore)
)
(defun init()
   (command "_.undo" "be")
   (setq dimzin (getvar "dimzin"))
   (setvar "dimzin" 1)
   (setq os (getvar "osmode"))
   (setvar "osmode" 0)
   (setvar "cmdecho" 0)
   (setq errtmp *error*)
   (setq *error* err)
)
(defun restore()
   (setq *error* errtmp)
   (setvar "dimzin" dimzin)
   (setvar "osmode" os)
   (command "_.undo" "e")
)
(defun xl-sort (lst fun / nlst)
   (foreach n lst (setq nlst (xl-isort n nlst fun))))
(defun xl-isort (item lst fun / k nlst)
   (setq k T
         nlst (apply 'append (mapcar '(lambda (x)
                                        (if (and K ((eval fun) item x)) (progn (setq k nil) (list item x)) (list x))
                                        ) lst))
   )
   (if k (append lst (list item)) nlst)
)
(defun setcolor(sname color / sinf)
   (setq sinf (entget sname))
   (if (assoc 62 sinf)
     (setq sinf (subst (cons 62 color) (assoc 62 sinf) sinf))
     (setq sinf (append sinf (list (cons 62 color))))
   )
   (entmod sinf)
)
(defun MakeText(pt Height Ang str / dxf)
   (setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model")(8 . "JZP")(100 . "AcDbText")))
   (setq dxf (append dxf (list (cons 10 pt) (cons 40 height) (cons 50 Ang) (cons 1 str))))
   (setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 0)
                           (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0))))
   (entmake dxf)
)
(defun MakeText2(pt Height Ang str / dxf)
   (setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model")(8 . "JZP")(100 . "AcDbText")(10 0.0 0.0 0.0)))
   (setq dxf (append dxf (list (cons 11 pt) (cons 40 height) (cons 50 Ang) (cons 1 str))))
   (setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 1)
                           (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))))
   (entmake dxf)
)
(defun MakeText3(pt Height Ang str / dxf)
   (setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model")(8 . "JZP")(100 . "AcDbText")(10 0.0 0.0 0.0)))
   (setq dxf (append dxf (list (cons 11 pt) (cons 40 height) (cons 50 Ang) (cons 1 (strcat "J" str)))))
   (setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 1)
                           (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))))
   (entmake dxf)
)
(defun OpPts(pts pt h scal / pti ptn ptc ang len params pts2 i)
   (setq pts_tmp nil)
   (if (equal (distance (car pts) (last pts)) 0 0.00000000001) (setq pts (cdr pts)))
   (setq pts2 (xl-sort pts '(lambda(e1 e2) (< (abs (- (angle pt e1) (/ pi 4))) (abs (- (angle pt e2) (/ pi 4)))))))
   
(setq i 1)
  (mapcar '(lambda(e)
              (MakeText3 (polar e (angle pt e) h) h 0.0 (itoa i))
              (setq i (1+ i))
            ) pts)
   (mapcar '(lambda(e)
              (MakeText2 (polar (cadr e) (+ (/ pi 2) (car e)) (* 0.75 h))
                h
                (if (and (> (car e) (/ pi 2.0)) (< (car e) (* pi 1.5)))
                         (- (car e) pi)
                  (car e)
                )
                (rtos (last e) 2 2)))
           params)
)
(defun GetVer(ent / pts ents)
   (while (/= (cdr (assoc 0 (setq ents (entget (setq ent (entnext ent)))))) "SEQEND")
     (setq pts (append pts (list (cdr (assoc 10 ents)))))
   )
   pts
)
(defun GETPL (ED / ENTS PTS)
   (setq ENTS (entget ED))
   (while (setq ENTS (member (assoc 10 ENTS) ENTS))
     (setq PTS (append PTS (list (cdar ENTS))))
     (setq ENTS (CDR ENTS))
   )
   PTS
)
(defun Order(pts / n pt ang angn angi angAll pt pti)
   (setq n (length pts))
   (setq pt (list (/ (apply '+ (mapcar 'car pts)) n)
                  (/ (apply '+ (mapcar 'cadr pts)) n)))
   (setq ang (angle pt (car pts)))
   (setq angAll 0)
   (foreach pti (append (cdr pts) (list(car pts)))
     (setq angn (angle pt pti))
     (setq angi (- angn ang))
     (cond
       ((> angi pi) (setq angi (- angi (* pi 2))))
       ((< angi (- pi)) (setq angi (+ angi (* pi 2))))
     )
     (setq angAll (+ angAll angi))
     (setq ang angn)
   )
   (cond
     ((equal angAll 0 1) (list pt nil))
     ((> angAll 0) (list pt nil))
     ((< angAll 0) (list pt t))   
   )
)
(defun DoubleM(ent / ents pt pts l h x y h2)
   (setq ents (entget ent))
   (if (= (cdr (assoc 0 ents)) "TEXT")
     (progn
       (setq pt (cdr (assoc 10 ents)))
       (setq pts (textbox ents))
       (setq l (caadr pts))
       (setq h (cdr (assoc 40 ents)))
       (setq x (+ l (* h 0.4)))
       (setq y (* h 0.7))
       (setq h2 (* h 0.5))
       (MakeText (list (+ (car pt) x) (+ (cadr pt) y)) h2 0 "2")
     )
   )
)

(defun c:zdt( / pts pt pti ptn ptc ang params)
   (init)
   (setq Scale (getstring "\n请输入比例尺<1:200>:"))
   (if (= Scale "")
     (progn
       (setq blc "1:200")
       (setq nScale 1)(setq h 0.45)
    )
     (progn
       (setq nScale (/ (atof scale) 200))
       (setq blc (strcat "1:" scale))
       (setq h (* 0.60 (/ (atof scale) 200) ))
    )
   )
   (setq ent (car  (entsel "\n请选择图形...")))
   (setq pts (getpl ent))
   (if (cadr (setq pt (Order (reverse pts))))
     (setq pts (reverse pts))
   )
   (setq pt (car pt))
   (setq xc (* 0.0 nscale))
  (command "_.pedit" ent "w" xc "")
   (setcolor ent 1)
   (OpPts pts pt h nscale)  
   (princ "\n\nEnd!")
   (restore)
   (princ)
)

nzl1116

2. (defun c:zdt (/ pts wnp dil dis)
   
3.   (setq        pts
   
4.          (mapcar 'cdr
   
5.                  (vl-remove-if
   
6.                    (function (lambda (x) (/= (car x) 10)))
   
7.                    (entget (car (entsel)))
   
8.                  )
   
9.          )
   
10.   )
    
11.   (or
    
12.     (< (apply
    
13.          '+
    
14.          (mapcar
    
15.            (function
    
16.              (lambda (pt1 pt2)
    
17.                (- (* (car pt1) (cadr pt2)) (* (cadr pt1) (car pt2)))
    
18.              )
    
19.            )
    
20.            (cons (last pts) pts)
    
21.            pts
    
22.          )
    
23.        )
    
24.        0
    
25.     )
    
26.     (setq pts (reverse pts))
    
27.   )
    
28.   (setq wnp (list (apply 'min (mapcar 'car pts)) (apply 'max (mapcar 'cadr pts))))
    
29.   (setq diL (mapcar (function (lambda (pt) (distance pt wnp))) pts))
    
30.   (setq dis (vl-position (apply 'min diL) diL))
    
31.   (or (= dis 0)
    
32.       (repeat dis
    
33.         (setq pts (append (cdr pts) (list (car pts))))
    
34.       )
    
35.   )
    
36.   (setq dis 0)
    
37.   (setq dil (append pts (list (car pts))))
    
38.   (foreach pt pts
    
39.     (entmakex
    
40.       (list
    
41.         '(0 . "TEXT")
    
42.         '(100 . "AcDbEntity")
    
43.         '(67 . 0)
    
44.         '(8 . "0")
    
45.         '(410 . "Model")
    
46.         '(100 . "AcDbText")
    
47.         '(10 0.0 0.0 0.0)
    
48.         (cons 11 (polar pt (+ (angle pt (cadr dil)) (* pi 0.5)) 8))
    
49.         (cons 40 5.0)
    
50.         (cons 1 (strcat "J" (itoa (setq dis (1+ dis)))))
    
51.         '(41 . 0.8)
    
52.         '(51 . 0.0)
    
53.         '(71 . 0)
    
54.         '(72 . 1)
    
55.         '(210 0.0 0.0 1.0)
    
56.         '(100 . "AcDbText")
    
57.         '(73 . 2)
    
58.       )
    
59.     )
    
60.     (setq dil (cdr dil))
    
61.   )
    
62.   (princ)
    
63. )

(defun c:zdt (/ pts wnp dil dis)<br />   (setq        pts<br />          (mapcar 'cdr<br />                  (vl-remove-if<br />                    (function (lambda (x) (/= (car x) 10)))<br />                    (entget (car (entsel)))<br />                  )<br />          )<br />   )<br />   (or<br />     (< (apply<br />          '+<br />          (mapcar<br />            (function<br />              (lambda (pt1 pt2)<br />                (- (* (car pt1) (cadr pt2)) (* (cadr pt1) (car pt2)))<br />              )<br />            )<br />            (cons (last pts) pts)<br />            pts<br />          )<br />        )<br />        0<br />     )<br />     (setq pts (reverse pts))<br />   )<br />   (setq wnp (list (apply 'min (mapcar 'car pts)) (apply 'max (mapcar 'cadr pts))))<br />   (setq diL (mapcar (function (lambda (pt) (distance pt wnp))) pts))<br />   (setq dis (vl-position (apply 'min diL) diL))<br />   (or (= dis 0)<br />       (repeat dis<br />         (setq pts (append (cdr pts) (list (car pts))))<br />       )<br />   )<br />   (setq dis 0)<br />   (setq dil (append pts (list (car pts))))<br />   (foreach pt pts<br />     (entmakex<br />       (list<br />         '(0 . "TEXT")<br />         '(100 . "AcDbEntity")<br />         '(67 . 0)<br />         '(8 . "0")<br />         '(410 . "Model")<br />         '(100 . "AcDbText")<br />         '(10 0.0 0.0 0.0)<br />         (cons 11 (polar pt (+ (angle pt (cadr dil)) (* pi 0.5)) 8))<br />         (cons 40 5.0)<br />         (cons 1 (strcat "J" (itoa (setq dis (1+ dis)))))<br />         '(41 . 0.8)<br />         '(51 . 0.0)<br />         '(71 . 0)<br />         '(72 . 1)<br />         '(210 0.0 0.0 1.0)<br />         '(100 . "AcDbText")<br />         '(73 . 2)<br />       )<br />     )<br />     (setq dil (cdr dil))<br />   )<br />   (princ)<br /> )

lhngxy

谢谢！！！

lhngxy

谢谢！！！！

lhngxy

谢谢！！！！

lhngxy

高手感谢您的帮助，谢谢

qq1254582201

看着很不错的样子啊，学习学习。。。

qq1254582201

lhngxy 发表于 2018-4-3 22:26
高手感谢您的帮助，谢谢

会有字体编号重复

lhngxy

7#  

应该是你的闭合线有重复节点把？

kugoo999

看着很不错的样子啊，学习学习。。。