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

本帖最后由 lhngxy 于 2018-4-4 08:09 编辑

(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)

)