CAD点总图坐标插件zb

* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;标注测量坐标的工具
;By Chshch.
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
(defun zb0(pt0 pt1 ang h pn)
(if (= h 0)
(setq h (getvar "textsize"))
);endif
(setq h1 (/ h 4.0))
(setq bpx (car pt0)
bpy (cadr pt0)
bpx1 (car pt1)
bpy1 (cadr pt1))
(setq stx (strcat "X=" (rtos bpy 2 3))
sty (strcat "Y=" (rtos bpx 2 3)))
(setq strlx (strlen stx)
strly (strlen sty))
(setq strl (max strlx strly))
(setq strl (+ h (* 0.85 h strl)))
(setq str (strcat "@" (rtos strl) "<" (rtos (* ang (/ 180.0 pi))) ) )
(if (or (> ang (* 1.5 pi)) (<= ang (* 0.5 pi)))
(setq pnl (+ h strl) strl h)
(setq ang (+ ang pi)
pnl (- (* -0.85 h (strlen pn)) h strl)
strl (- 0 strl)
)
)
(setq strx1 (- (+ bpx1 (* strl (cos ang))) (* (sin ang) h1) )
stry1 (+ (+ bpy1 (* strl (sin ang))) (* (cos ang) h1) ) ;坐标1，标注X坐标值
strx2 (+ (+ bpx1 (* strl (cos ang))) (* (sin ang) (+ h1 h)) )
stry2 (- (+ bpy1 (* strl (sin ang))) (* (cos ang) (+ h1 h)) ) ;坐标2，标注Y坐标值
strx3 (+ (+ bpx1 (* pnl (cos ang))) (* (sin ang) (/ h 2)) )
stry3 (- (+ bpy1 (* pnl (sin ang))) (* (cos ang) (/ h 2)) ) ;坐标3，标注点的序号
)
(setq ang (* ang (/ 180.0 pi)) )

(setq osvar (getvar "osmode"))
(setvar "osmode" 0)
(command "pline" pt0 pt1 str "") ;画线命令
(command "text" (list strx1 stry1) h (rtos ang) stx)
(command "text" (list strx2 stry2) h (rtos ang) sty)
(command "text" (list strx3 stry3) h (rtos ang) pn)
(setvar "osmode" osvar)
;(setvar "textsize" text_s)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;返回值 实体的各顶点
;功能 自动标注目标实体端点的X Y坐标
;语法 (vertexs ename)
;参数 ename: 图元名
;; XL: 引线长
;; ang: 标注角度
;; th: 字高
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun vertexs (ename xl ang fx th pn / plist pts pte xm LisC n rr)

(setq obj (vlax-ename->vla-object ename)) ;Transforms entity to VLA-object
(setq pts (vlax-curve-getstartpoint obj)
pte (vlax-curve-getendpoint obj)
) ;获取实体的起、终点坐标
(setq LisC (not t))
(setq objp (cdr (assoc 0 (entget ename)))) ;获取实体的类型
(if (= (strcase objp) "LWPOLYLINE") ;判断是否是多义线
(progn ;progn1 是多义线
(setq plist (vlax-safearray->list
(vlax-variant-value (vla-get-coordinates obj)) )
);获取顶点坐

标列表，格式为：(x0 y0 x1 y1 x2 y2 x3 y3 ......)
;检查并删除重复顶点,并将格式转换为 ((x0 y0) (x1 y1) (x2 y2) .....), 同时搜索最小的X坐标xm
(setq n 2
pln (length plist)
x0 (nth 0 plist)
y0 (nth 1 plist)
xm x0
)
(setq plist (append plist (list (list 0 0) (list x0 y0)) )) ;(0 0) 是新列表的分隔标志
(repeat (/ (- pln 2) 2)
(setq x1 (nth n plist)
y1 (nth (1+ n) plist)
)
(if (< (- x1 xm) 0.0001) (setq xm x1)) ;X1;重复的顶点处理
(if (or (> (abs (- x1 x0)) 0.0001) (> (abs (- y1 y0)) 0.0001)) ;判定是否是重复的顶点
(progn ; 不是重复的顶点，将 X1、Y1 的值赋予 X0、Y0
(setq x0 x1 y0 y1) ;x0=x1 , y0=y1
(setq plist (append plist (list (list x0 y0)) ))
);progn ; 不是重复的顶点，将 X1、Y1 的值赋予 X0、Y0
)

(setq n (+ n 2))
) ;end repeat (/ (length plist) 2)|;
(setq plist (cdr (member (list 0 0) plist)))

;闭合曲线处理
(if (and (= (car pts) x0) (=(cadr pts) y0) )
(setq LisC t plist (cdr plist))
);起终点坐标相同，按闭合曲线处理（要删除终点）
(if (or LisC (vlax-curve-isClosed Obj)) ;then 是否是封闭的曲线实体，是闭全曲线时从最左边的点开始标注（X坐标最小）
(progn ;progn2
(setq LisC t)
(setq plist (append (member (assoc xm plist) plist) ;将X坐标最小的点移到最前面，
(reverse (cdr (member (assoc xm plist) (reverse plist))) ))) ;原来在这个点前的坐标全部移至最后
(setq an1 (angle (car plist) (last plist))
an2 (angle (car plist) (cadr plist))
);计算起始线段的方向角.
(if (= (> (cos (/ (+ an1 an2) 2)) 0) (> an1 an2) ) (setq rr 1) (setq rr -1) )
(if (/= fx rr) (setq rr fx plist (append (list (car plist)) (reverse (cdr plist)) ) ) )
;|闭合曲线的旋转方向判断及设置
以起始顶点（最左边的顶点，也就是 X 坐标最小的点）中心，
主要参数： AN1 表示 X 轴与第一条线段的夹角
AN2 表示 X 轴与第二条线段的夹角
(an1+an2)/2 表示 X 轴与两线段平分线夹角
封闭曲线方向与 AN1 AN2 之间的关系表
序号 cos((an1+an2)/2)的值 AN1与AN2的大小关系 闭合曲线的旋转方向 rr
1 cos((an1+an2)/2) > 0 AN1 > AN2 逆时针 1
2 cos((an1+an2)/2) > 0 AN1 < AN2 顺时针 -1
3 cos((an1+an2)/2) < 0 AN1 > AN2 顺时针 -1

4 cos((an1+an2)/2) < 0 AN1 < AN2 逆时针 1
|;
(setq plist (append (list (last plist)) plist (list (car plist)) ) );在plist首尾各增加一个点，方便计算封闭曲线的内夹角
) ;end progn2
);end if (or LisC (vlax-curve-isClosed Obj)) ;then 是否是封闭的曲线实体，

) ;end progn1 是多义线 结束
;(progn ;else
;不是多义线，只标注起、终点，下式计算坐标值列表，前后增加两点(0,0)。
(setq plist (list (list (car pts) (cadr pts)) (list (car pte) (cadr pte)) ) )
;);end else
);end if (= (strcase objp) "LWPOLYLINE") ;判断是否是多义线

(if (/= t LisC) (setq plist (append (list (list 0.0 0.0)) plist (list (list 0.0 0.0))) ))

(setq n 1 pln (length plist) ang2 (* 0.38 pi))
(repeat (- pln 2)
(if (= t LisC)
(progn
(setq an1 (angle (nth n plist) (nth (1- n) plist))
an2 (angle (nth n plist) (nth (1+ n) plist))
ang2 (/ (+ an1 an2) 2)
)
(if (> (* rr an1) (* rr an2)) (setq ang2 (+ pi ang2)))
(setq ang2 (- ang2 (* (fix (/ ang2 2 pi)) 2 pi)))
) )
(setq x1 (+ (car (nth n plist)) (* xl (cos ang2)))
y1 (+ (cadr (nth n plist)) (* xl (sin ang2)))
)
(if (< (cos (- ang2 ang)) 0.0)
(if (>= ang pi)
(setq ang2 (- ang pi))
(setq ang2 (+ ang pi))
)
(setq ang2 ang)
)
(zb0 (nth n plist) (list x1 y1) ang2 th (strcat pn (itoa n) "#"))
(setq n (+ n 1))
) ;end repeat (/ (length plist) 2)
)

;* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;标注测量坐标的工具,手动标注
;By chshch.
;2007.02.09
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
(defun c:sb()

(setq text_s (getvar "textsize"))
(initget 1)
(setq bp (getpoint "\n请输入欲标注的点: "))
(initget 1)
(setq bp1 (getpoint bp "引出线: "))
(setq ang (getangle bp1 "标注文本的方向角 <0>: "))
(initget 4)
(setq h (getdist bp1 (strcat "\n请输入字高 <" (rtos text_s) ">:")))
(initget 4)
(setq pn (getstring "\n请输入界址点的完整编号 : "))
(if (= ang nil)
(setq ang 0)
)

(if (= h nil)
(setq h text_s)
)
(zb0 bp bp1 ang h pn)

)
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;标注测量坐标的工具,自动标注
;By chshch.
;2007.02.09
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;功能 选择实体集合,自动标注实体端点的X Y坐标
;语法 (vertexs ename)
;参数 ename: 图元名
;; XL: 引

线长
;; ang: 标注角度
;; h: 字高
(defun c:zb()
(initget 1)
(setq SS (ssget '((0 . "LINE,*POLYLINE,ARC")))) ;选择实体;Creates a selection set from the selected object
(setq text_s (getvar "textsize"))
(initget 2)
(setq XL (getdist "引出线长度 <5.5倍字高>: "))
(initget 4)
(setq h (getdist (strcat "\n请输入字高 <" (rtos text_s) ">:")))
(setq ang (getangle "\n请输入标注文本的角度 <0>: "))
(setq pn (getstring "\n请输入界址点编号的前缀字符 : "))
(initget "- +")
(setq fx (getkword "\n请指定界址点排列方式 [顺时针(-)/逆时针(+)] <->: "))
(if (= ang nil) (setq ang 0) )
(if (= fx nil) (setq fx "-") ) ;(ascii "+") = 43 (ascii "-") = 45
(if (= h nil) (setq h text_s) )
(if (= XL nil) (setq XL (* 5.5 h)) )
(vl-load-com) ;Loads Visual LISP extensions to AutoLISP
(setq N 0)
(repeat (sslength SS) ;repeat :循环 ;sslength ：Returns an integer containing the number of objects (entities) in a selection set
(vertexs (ssname SS N) xl ang (- 44 (ascii fx)) h pn) ;SSNAME : Returns the object (entity) name of the indexed element of a selection set
(setq N (1+ N))
) ;end repeat
(princ)
)

(princ "\n坐标标注程序已装载, 键入zb自动批量标注；键入 sb 逐点手动标注。")
(princ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;test;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;(defun test_x(obj)
;|(princ "\n<><><><><><><><><><><><><><><><><><><><><>\n")
(princ (vlax-vla-object->ename Obj))
(princ "\n")
(princ obj)
(princ "\nvlax-curve-isClosed: ")
(princ (vlax-curve-isClosed Obj))
(princ "\nLWPOLYLINE in obj: ")
;(princ (vl-string-search "LWPOLYLINE" (vl-list->string obj)))
;(princ (nth 1 obj))
(princ "\n<><><><><><><><><><><><><><><><><><><><><>\n");|;
;)Command: (setq sample ) (A B (C D) B) Command: (subst 'qq 'b '(a b (c d) b))