加载中…
个人资料
  • 博客等级:
  • 博客积分:
  • 博客访问:
  • 关注人气:
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
正文 字体大小:

测量作图常用lisp程序(3)   AutoCAD  自己编写(江西理工大学 王军锋&n

(2014-10-09 10:03:22)
分类: 测量


 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;示坡线绘制程序2.0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                                     ;;
;;   1、本程序的功能为绘制垂直于已知线段的示坡线。                                     ;;
;;                                                                                     ;;
;;   2、程序主命令为"SPX",在命令行中输入"SPX"按提示使用即可。                          ;;
;;                                                                                     ;;
;;   3、本程序可用于多段线和二维带高程多段线示坡线的标注。                             ;;
;;                                                                                     ;;
;;   4、本程序可以对封闭的多段线进行操作。                                             ;;
;;                                                                                     ;;
;;   5、如果坡线位置不对,请在不同位置或方向上多试几次。                               ;;
;;                                                                                     ;;
;;                                                                     2011.8.11       ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 
  (vl-load-com);载入com,以使本程序可以使用VLisp函数
  (setq AcadObject (vlax-get-acad-object))
  (setq AcadDocument (vla-get-ActiveDocument Acadobject))
  (setq mSpace (vla-get-ModelSpace Acaddocument))
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                 定义主命令函数"SPX"                                 ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:SPX()
      ;;预处理部分
    (command "_.UNDO" "Group");设置后退起点
    (setq old_cmd (getvar "cmdecho"))
    (setq old_osm (getvar "osmode"))
    (setvar "cmdecho" 0)
    (setq layerSel (vla-get-Layers AcadDocument))           ;和下一行一起建立一个新的图层。
    (setq layerObj (vla-add layerSel "示坡线"))             ;图层名称为:  "示坡线"
    (vla-put-Color layerObj acYellow)                       ;图层颜色为:   黄色              
                                                            ;开始执行
      (setq pd (entsel "选取坡顶线:"))
      (setq pdx (car pd))                                   ;把选中的图元即线,赋值给pdx.
      (if (vlax-curve-isClosed pdx)                         ;如果曲线是封闭的,则先使其不闭合,操作完成后再闭合。
             (progn
         (setq pdx_assoc (entget pdx))
                (setq str1 (cdr (assoc 0 pdx_assoc)))
                (if (= str1 "POLYLINE")
                    (progn    
                       (setq pdx (vlax-ename->vla-object pdx))  ;把普通图元转换为vlax对象。
                        (vla-put-closed pdx 0)                   ;使二维多段线先不闭合。
                        (setq startpoint (vlax-curve-getStartPoint  pdx))     ;得出选中线段的起点。                
                        (setq endpoint (vlax-curve-getEndPoint pdx))          ;得出选中线段的终点。
                        (setq distance_2p (distance startpoint endpoint))     ;求出起点和终点之间的距离。
                        (setq dis (/ distance_2p 1000))                       ;设置在起点和终点之间,距离起点的最小距离。
                        (command "_pline" startpoint endpoint "")             ;临时画一条从起点到终点的多段线。
                        (setq pdx_temp (entlast))                             ;选中刚才最后画的这条多段线。
                        (setq pdx_temp (vlax-ename->vla-object pdx_temp))     ;把普通图元转换为vlax对象。
                               (setq point1_spx (vlax-curve-getPointAtDist pdx_temp dis)) ;取得距离临时多段线起点最近的端点point1_spx
                               (setq
                                        point1_x  (car point1_spx)         ;点1的x值              
                                        point1_y  (cadr point1_spx)        ;点1的y值     
                               )
                        (vla-delete pdx_temp)                              ;删除临时多段线。
                        (setq startPnt (vlax-make-safearray vlax-vbDouble '(0 . 2)))   ;建立安全数组变量。
                        (setq pts (vlax-variant-value (vla-get-coordinates pdx)))      ;把多段线的全部三维点坐标赋值给pts。
                        (setq gaocheng (vlax-safearray-get-element pts 2))             ;从pts中提取出Z值,即多段线的高程值。
                        (setq pts1 (list point1_x point1_y gaocheng))                  ;把点1的坐标值赋给pts1。
                        (vlax-safearray-fill startPnt pts1)                            ;把pts1赋值给开始点。
                        (setq upper_num (vlax-safearray-get-u-bound pts 1) )           ;找出pts中有多少个坐标点个数,包含X Y Z ,一个坐标算3个个数。
                       (setq half_t (/ (+ upper_num 1) 3))                            ;求出有多少个点,从0开始算起。
                        (vla-AppendVertex pdx  startPnt )                              ;追加端点。
                        (vla-Update pdx)                                               ;更新多段线。
                        (setq pdx (vlax-vla-object->ename pdx))  ;把vlax对象转换为普通对象。
                        (drawspx pd pdx)                         ;调子函数。
                       (setq pdx (vlax-ename->vla-object pdx))  ;把普通图元转换为vlax对象。
                        (vla-put-closed pdx -1)                  ;使二维多段线再闭合。
                     )
                     (progn
                       (setq pdx (vlax-ename->vla-object pdx))  ;把普通图元转换为vlax对象。
                        (vla-put-closed pdx 0)                   ;使二维多段线先不闭合。
                        (setq startpoint (vlax-curve-getStartPoint  pdx))     ;得出选中线段的起点。                
                        (setq endpoint (vlax-curve-getEndPoint pdx))          ;得出选中线段的终点。
                        (setq distance_2p (distance startpoint endpoint))     ;求出起点和终点之间的距离。
                        (setq dis (/ distance_2p 1000))                       ;设置在起点和终点之间,距离起点的最小距离。
                        (command "_pline" startpoint endpoint "")             ;临时画一条从起点到终点的多段线。
                        (setq pdx_temp (entlast))                             ;选中刚才最后画的这条多段线。
                        (setq pdx_temp (vlax-ename->vla-object pdx_temp))     ;把普通图元转换为vlax对象。
                               (setq point1_spx (vlax-curve-getPointAtDist pdx_temp dis)) ;取得距离临时多段线起点最近的端点point1_spx
                               (setq
                                        point1_x  (car point1_spx)         ;点1的x值              
                                        point1_y  (cadr point1_spx)        ;点1的y值     
                               )
                        (vla-delete pdx_temp)                              ;删除临时多段线。
                        (setq startPnt (vlax-make-safearray vlax-vbDouble '(0 . 1)))   ;建立安全数组变量。
                        (setq pts (vlax-variant-value (vla-get-coordinates pdx)))      ;把多段线的全部三维点坐标赋值给pts。


                        (setq pts1 (list point1_x point1_y))                  ;把点1的坐标值赋给pts1。
                        (vlax-safearray-fill startPnt pts1)                            ;把pts1赋值给开始点。
                        (setq upper_num (vlax-safearray-get-u-bound pts 1) )           ;找出pts中有多少个坐标点个数,包含X Y Z ,一个坐标算3个个数。
                       (setq half_t (/ (+ upper_num 1) 2))                            ;求出有多少个点,从0开始算起。
                        (vla-AddVertex pdx  half_t startPnt )                          ;追加端点。
                        (vla-Update pdx)                                               ;更新多段线。
                        (setq pdx (vlax-vla-object->ename pdx))  ;把vlax对象转换为普通对象。
                        (drawspx pd pdx)                         ;调子函数。
                       (setq pdx (vlax-ename->vla-object pdx))  ;把普通图元转换为vlax对象。
                        (vla-put-closed pdx -1)                  ;使二维多段线再闭合。                    
                                     
                );if  
                  
             )
             (progn
                   (drawspx pd pdx)                         ;调子函数。
             )
       );;if
      ;;结束部分
    (setvar "cmdecho" old_cmd)
    (setvar "osmode" old_osm)
    (command "_.UNDO" "End");设置后退终点
    (redraw)
    (princ)
)
 
 
 
 
(defun drawspx (pd pdx) 
 
              (setq pt1 (cadr pd));pt1为选择线段时的第一个点取点。
              (setq pt2 (getpoint "指定一点确定示坡线的长度及方向:"))
              (setvar "osmode" 0);关闭捕捉
              (setq isleft_pt2 (isLeft pt2 pdx));判断是否在线的左侧
              (setq d (getreal "指定示坡线间距[9]:"))
              (if d
                  (setq d d)         ;把示坡线的间距赋值给d,如果无输入则执行下一行赋值程序。
                  (setq d 9.0)       ;把示坡线的默认间距赋值给d.
              )
              (setq len (getreal "指定示坡线的最大长度[9]:"))
              (if len
                  (setq len len)
                  (setq len 9.0)
              )
              (setq cxbl (getreal "指定长线的比例[0.9]:"))
              (if cxbl
                  (setq cxbl cxbl)
                  (setq cxbl 0.9)
                        
               (setq dxbl (getreal "指定短线的比例[0.5]:"))
              (if dxbl
                  (setq dxbl dxbl)
                  (setq dxbl 0.5)
                 
              (setq endpoint (vlax-curve-getEndPoint pdx))          ;得出选中线段的终点。
              (setq l (vlax-curve-getDistAtPoint pdx endpoint))     ;得出选中线段的长度。
              (setq dis 0)                                          ;设置距离dis为0.                     
              (setq qhfh 1)                                         ;设置切换符号,区分长短线。
              (while (<= dis (- l d))                               ;当示坡线的间距小于线段的长度时。
                    (progn ;;progn2
                          (setq dis (+ dis d))
                          (setq point1_spx (vlax-curve-getPointAtDist pdx dis))                                   ;取得示坡线位于坡顶的端点point1_spx
                          (setq firstDriv (vlax-curve-getFirstDeriv pdx (vlax-curve-getParamAtDist pdx dis)))     ;取得point1_spx处曲线的切向矢量
                          (setq
                                   deriv_x  (car firstDriv)           ;此处切向量的x坐标值
                                   deriv_y  (cadr firstDriv)          ;此处切向量的y坐标值
                          )
                          (setq  deriv_l (sqrt (+ (* deriv_x deriv_x) (* deriv_y deriv_y))))      ;切向量的长度,x^2+y^2再开根号
                          (setq
                                point2_x1 (/ deriv_x deriv_l)         ;切向量的cosa值
                                point2_y1 (/ deriv_y deriv_l)         ;切向量的sina值
                          )
                          (setq
                                   point1_x  (car point1_spx)         ;点1的x值              
                                   point1_y  (cadr point1_spx)        ;点1的y值      
                          )
   
                      (if (= qhfh 1)
                          (setq leng  (* len dxbl))      ;设置短线的长度
                          (setq leng  (* len cxbl))      ;设置长线的长度  
                                        
                          (setq
                                   point2_x  (+ point1_x (* point2_x1 leng))      ;点2的x值,由;点1的x值加上  要画的线段长度*cosa   ,从而保证相切处旋转后和已有线段垂直。
                                   point2_y  (+ point1_y (* point2_y1 leng))      ;点2的y值,由;点1的y值加上  要画的线段长度*sina   ,从而保证相切处旋转后和已有线段垂直。
                          )
                                                                                  ;绘制示坡线
                          (setq pts1 (list point1_x point1_y 0))                  ;把点1的坐标值赋给pts1。
                          (setq pts2 (list point2_x point2_y 0))
                          (setq startPnt (vlax-make-safearray vlax-vbDouble '(0 . 2)))           ;建立安全数组变量。
                          (setq endPnt (vlax-make-safearray vlax-vbDouble '(0 . 2)))
                          (vlax-safearray-fill startPnt pts1)                                    ;把pts1赋值给开始点。
                          (vlax-safearray-fill endPnt pts2)
                          (setq LineObj(vla-Addline mSpace startPnt endPnt))                     ;画直线。
                        (vla-put-Layer LineObj "示坡线")                                       ;把刚才所画的直线存储到  示坡线  图层。
                          (if (= isleft_pt2 1)                                                   ;根据判断的示坡线的方向来旋转刚才画的直线。
                              (command "rotate" "L" "" point1_spx "90")
                              (command "rotate" "L" "" point1_spx "-90")
                          );;if
                          (setq qhfh (* -1.0 qhfh));切换长短线
                    );;progn2
              );;while
)
 
 
 
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                 定义命令别名"示坡线"                                ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:示坡线()
      (C:SPX)
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 定义isLeft函数,功能为判断线外一点是否在曲线左侧,若在左侧,则返回"1",反之返回"0"  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun isLeft(pt_given curve)
      (setq pt_get (vlax-curve-getClosestPointTo curve pt_given))
      (setq para_get (vlax-curve-getParamAtPoint curve pt_get))
      (setq deriv_given (vlax-curve-getFirstDeriv curve para_get))
    (command "line" pt_given pt_get "")
    (setq line_get (entlast))
    (command "rotate" line_get "" pt_get "-90")
    (setq ax_line_get (vlax-ename->vla-object line_get))    
    (setq deriv_get (vlax-curve-getFirstDeriv ax_line_get 1))
    (setq L1 (cadr deriv_given) L2 (car deriv_given))
    (setq M1 (cadr deriv_get) M2 (car deriv_get))
    (if (and (>= (* L1 M1) 0.0) (equal (/ L2 L1) (/ M2 M1) 0.0001))
          (setq yon 0)
          (setq yon 1)
    );;if
    (entdel line_get)
    yon
)

 

 

 

 ;----------------------------------------------------------------------------------------------------------------------------------------------------------
 ;----------------------------------------------------------------------------------------------------------------------------------------------------------
 
 
 
 
 ;标注测量坐标的工具
;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 2))
    sty (strcat "Y=" (rtos bpx 2 2)))
  (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
   cos((an1+an2)/2) > 0       AN1 > AN2              逆时针          1
   cos((an1+an2)/2) > 0       AN1 < AN2              顺时针         -1
   cos((an1+an2)/2) < 0       AN1 > AN2              顺时针         -1
   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))

 

 

 

 ;----------------------------------------------------------------------------------------------------------------------------------------------------------
 ;----------------------------------------------------------------------------------------------------------------------------------------------------------
 
 
 

0

阅读 收藏 喜欢 打印举报/Report
  

新浪BLOG意见反馈留言板 欢迎批评指正

新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 产品答疑

新浪公司 版权所有