;标注测量坐标的工具

;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 "\

请输入欲标注的点: "))

(initget 1)

(setq bp1 (getpoint bp "引出线: "))

(setq ang (getangle bp1 "标注文本的方向角 <0>: "))

(initget 4)

(setq h (getdist bp1 (strcat "\

请输入字高 <" (rtos text_s) ">:")))

(initget 4)

(setq pn (getstring "\

请输入界址点的完整编号 : "))

(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 "\

请输入字高 <" (rtos text_s) ">:")))

(setq ang (getangle "\

请输入标注文本的角度 <0>: "))

(setq pn (getstring "\

请输入界址点编号的前缀字符 : "))

(initget "- +")

(setq fx (getkword "\

请指定界址点排列方式 [顺时针(-)/逆时针(+)] <->: "))

(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 "\

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

(princ)

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

;(defun test_x(obj)

;|(princ "\

<><><><><><><><><><><><><><><><><><><><><>\

")

(princ (vlax-vla-object->ename Obj))

(princ "\

")

(princ obj)

(princ "\

vlax-curve-isClosed: ")

(princ (vlax-curve-isClosed Obj))

(princ "\

LWPOLYLINE in obj: ")

;(princ (vl-string-search "LWPOLYLINE" (vl-list->string obj)))

;(princ (nth 1 obj))

(princ "\

<><><><><><><><><><><><><><><><><><><><><>\

");|;

;)Command: (setq sample ) (A B (C D) B) Command: (subst 'qq 'b '(a b (c d) b))下载本文