[原创]：发几个小程序，自己用的，

hbxiaofeng

1.计算选择面域的形心惯性矩，主矩方向等参数（标注在图形上）jmcs
2.计算线长（所有线的长度包括pline,spline line arc circle 椭圆，并且可以将每个长度标注在图形上）xcjs,xcbz
3.隐藏图形，可以将一部分图形隐藏起来，不是关闭图层hh
4.关闭选择对象所在的图层ol,cl



(defun c:jmcs(/ v2l jmcsfun regionss regionobj index n)
(defun V2L (x)
  (vlax-safearray->list (vlax-variant-value x))
)



(defun jmcsfun(jmobj / area perimeter centroid momentofinertia1 principalmoments1 principaldirections1
            productofinertia1 txthight circlerad arrowlen angle1 angel2 txtpt txtstring )

  (setq area (vla-get-area jmobj)
        perimeter (vla-get-perimeter jmobj)
        centroid  (V2L(vla-get-centroid jmobj))
  )
  (vla-move jmobj (vlax-3d-point centroid) (vlax-3d-point (list 0 0 0)))
  (setq momentofinertia1 (V2L(vla-get-momentofinertia jmobj))
        principalmoments1 (V2L(vla-get-principalmoments jmobj))
        principaldirections1(V2L(vla-get-principaldirections jmobj))
        productofinertia1 (vla-get-productofinertia jmobj)
  )
  (vla-move jmobj (vlax-3d-point (list 0 0 0)) (vlax-3d-point centroid))
  (setq txthight (/ (getvar "viewsize") 90.0))
  (setq circlerad (* txthight 1.5))
  (setq arrowlen  (* txthight 5))
  (setq angle1 (angle (list 0 0 0) (list (car principaldirections1)(caddr principaldirections1))))
  (setq angle2 (angle (list 0 0 0) (list (cadr principaldirections1)(cadddr principaldirections1))))
  (setq txtpt (polar centroid angle1 arrowlen))
  (entmake (list (cons 0 "line") (cons 10 centroid)(cons 11 txtpt)(cons 62 1)))
  (entmake (list (cons 0 "text") (cons 1 "1") (cons 40 txthight)(cons 10 txtpt)(cons 11 txtpt)(cons 62 1)))
  (setq txtpt (polar centroid angle2 arrowlen))
  (entmake (list (cons 0 "line") (cons 10 centroid)(cons 11 txtpt)(cons 62 1)))
  (entmake (list (cons 0 "text") (cons 1 "2") (cons 40 txthight)(cons 10 txtpt)(cons 11 txtpt)(cons 62 1)))

  (setq txtstring (strcat "Area= " (rtos area 2 0) )
        txtpt centroid
  )
  (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 11 txtpt)))


  (setq txtstring (strcat "Perimeter= " (rtos  perimeter 2 0))
        txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
  )
  (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 11 txtpt)))



  
  (setq txtstring (strcat "Ix= " (rtos (car momentofinertia1) 1 7))
        txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
  )
  (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 11 txtpt)))


  
  (setq txtstring (strcat "Iy= " (rtos (cadr momentofinertia1) 1 7))
        txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
  )
  (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 11 txtpt)))



  (setq txtstring (strcat "Ixy= " (rtos  productofinertia1 1 7))
        txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
  )
  (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 11 txtpt)))

  

  (setq txtstring (strcat "I1= " (rtos (car principalmoments1) 1 7))
        txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
  )
  (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 11 txtpt)))


  (setq txtstring (strcat "I2= " (rtos (cadr principalmoments1) 1 7))
        txtpt (list (car txtpt)(-(cadr txtpt) (* txthight 2)))
  )
  (entmake (list (cons 0 "text") (cons 1 txtstring)(cons 40 txthight) (cons 10 txtpt)(cons 11 txtpt)))

  
  
)

  (vl-load-com)
  (princ "\n请选择需要计算截面参数的面:")
  (setq regionss (ssget (list (cons 0 "region")))
        index 0
        n        (if regionss (sslength regionss) 0)
  )
  (repeat n
    (setq regionobj (vlax-ename->vla-object  (ssname regionss index))
          index (1+ index)
    )
    (jmcsfun regionobj)
  )
  (alert "\n\n图中所表示的惯性矩意义如下:\n\n
   两条直线代表主矩方向1和2\n
   I1为主矩方向1的质心主惯性矩\n
   I2为主矩方向2的质心主惯性矩\n
   Ix,Iy,Ixy均为质心惯性矩"
            
  )


;;;;线长标注，命令名称xcbz
;;;;总线长计算，命令名称xcjs
;;;;利用当前标注样式标注多义线各段长度（包括弧线部分）点哪一段标注哪一段，命令linedim   


;;;;;*********************线长标注，命令名称xcbz
(defun addlayer(layername / doc layers layer)
  (vl-load-com)
  (setq acadobj (vlax-get-acad-object)
        doc  (vla-get-activedocument acadobj)
        layers (vla-get-layers doc)
        layer  (vla-add layers layername)
  )
)

(defun maketxt(txtstring pt txth layername color ang )
  (entmake (list (cons 0 "text")(cons 1 txtstring)(cons 40 txth)(cons 8 layername)(cons 62 color)
                 (cons 10 pt)(cons 11 pt)(cons 41 0.71)(cons 50 ang)))
)

(defun c:xcbz(/ xcbzss xcbzlen index sumlen entname len midparam midpt entobj endparam
                midderiv txtang txth )
  (vl-load-com)
  (princ "\n请选择要标注线长的直线，多义线，圆，圆弧，椭圆，spline线:")
  (setq xcbzss (ssget (list (cons -4 "<or")(cons 0 "*line")(cons 0 "arc")(cons 0 "ellipse")(cons 0 "circle")
                            (cons -4 "or>")))
        xcbzlen (if xcbzss (sslength xcbzss) 0)
        index 0
        sumlen 0.0
  )
  (repeat xcbzlen
    (setq entname (ssname xcbzss index)
          index (1+ index)
          entobj (vlax-ename->vla-object entname)
          endparam (vlax-curve-getendparam entobj)
          len (vlax-curve-getdistatparam entobj endparam)
          midparam (vlax-curve-getparamatdist entobj (* 0.5 len))
          midpt (vlax-curve-getpointatparam entobj midparam)
          midderiv (vlax-curve-getfirstderiv entobj midparam)
          txtang (angle (list 0 0 0) midderiv)
          txtang (if (and (> txtang (* 0.5 pi))(<= txtang (* 1.5 pi)))
                     (- txtang pi) txtang)
          txth   (/ (getvar "viewsize") 90.0)
          sumlen (+ sumlen len)
     )
     (addlayer "线长标注")
     (maketxt (rtos len 2 0) midpt txth "线长标注" 1 txtang)
   )
   (alert (strcat "\n共计:【 " (itoa xcbzlen) " 】 个对象
                   \n总长:【 " (rtos sumlen 2 0) " 】"))
   (princ)
  )
   



(defun get-curve-length(entname / objname endparam curvelength)
  (setq objname (vlax-ename->vla-object entname)
        endparam (vlax-curve-getendparam objname)
        curvelength(vlax-curve-getdistatparam objname endparam)
  )
  (if (null curvelength) 0 curvelength)

)



;;;;**********************************总线长计算，命令名称xcjs      
(DEFUN C:xcjs(/ lengthss index sumlength entname)
  (vl-load-com)
  (setq lengthss (ssget (list (cons -4 "<or")(cons 0 "*line")(cons 0 "arc")(cons 0 "ellipse")(cons 0 "circle")
                            (cons -4 "or>")))
        index 0
        sumlength 0.0
        xcjslen (if lengthss (sslength lengthss) 0)
  )
  (repeat xcjslen
    (setq entname (ssname lengthss index)
          index   (1+ index)
          sumlength (+ sumlength (get-curve-length entname))
    )
  )
  (alert (strcat "\n共计:【 " (itoa xcjslen) " 】 个对象
                   \n总长:【 " (rtos sumlength 2 0) " 】"))
)

;;;;*************************************************************************
;;;;标注多义线各段长度命令名称linedim(标注多义线的各段长度包括多义线中的圆弧)
(defun pdim(eobject pt / dimlfac pt paramno len )
  (setvar "cmdecho" 0)
  (setq dimlfac (getvar "dimlfac"))
  (setq pt (vlax-curve-getclosestpointto eobject pt)
        paramNo (vlax-curve-getparamatpoint eobject pt)
        paramNo (fix paramNo)
        len     (- (vlax-curve-getdistatparam eobject (1+ paramNo))
                   (vlax-curve-getdistatparam eobject paramNo))
  )
  (setq len (/ len dimlfac))
  (if (equal (vlax-curve-getsecondderiv eobject (+ paramno 0.5)) (list 0 0 0))
      (vl-cmdf "dimaligned" (vlax-curve-getpointatparam eobject paramno)
                        (vlax-curve-getpointatparam eobject (1+ paramno))pause)
      (vl-cmdf "dimangular" pt "t" (rtos len 2 1) pause)
  )
  (setvar "cmdecho" 1)
)

(defun arcdim(obj pt typ / startparam endparam len dimlfac)
  (setvar "cmdecho" 0)
  (setq dimlfac (getvar "dimlfac"))
  (setq startpoint (vlax-curve-getstartpoint obj)
        endpoint   (vlax-curve-getendpoint obj)
        len (- (vlax-curve-getdistatpoint obj endpoint)(vlax-curve-getdistatpoint obj startpoint))
        len (/ len dimlfac)
  )
  (cond((= typ "ARC") (vl-cmdf "dimangular" pt "t" (rtos len 2 1) pause))
       ((= typ "LINE") (vl-cmdf "dimaligned" startpoint endpoint pause))
       ((= typ "SPLINE") (vl-cmdf "dimaligned" startpoint endpoint
                                  "t" (strcat "Sum Len Of Curve=" (rtos len 2 1)) pause))
  )
  (setvar "cmdecho" 1)
)

(defun c:linedim(/ enamesel pt obj typ entdata)
  (vl-load-com)
  (setq enamesel (entsel)
        pt (cadr enamesel)
        obj(vlax-ename->vla-object (car enamesel))
        pt (vlax-curve-getclosestpointto obj pt)
        entdata(entget (car enamesel))
        typ(cdr (assoc 0 entdata ))
  )
  (cond ((or (= typ "LINE")( = typ "SPLINE")(= typ "ARC" )) (arcdim  obj pt typ))
        ((= typ "LWPOLYLINE")(pdim obj pt))
        (t (princ "\n你选择的图形无法标注"))
  )
  (princ)
)


;;;;;隐藏图形

(defun c:hh()
  (vl-load-com)
  (princ "\n选择需要隐藏的物体")
  (setq hidess (ssget))
  (if (null hidess)
      (showall mytools_hidess)
      (hide hidess)
  )
  (princ)
)

(defun showall( ss / index ename eobj n)
  (setq ss (if mytools_hidess mytools_hidess (ssget "a"))
        mytools_hidess (ssadd)
        index 0
  )
  (repeat (sslength ss)
    (setq ename (ssname ss index)
          eobj  (vlax-ename->vla-object ename)
          index (1+ index)
    )
    (if (= (vla-get-visible eobj) :vlax-false) (vla-put-visible eobj t))
  )

)

(defun hide( ss / index ename eobj)
  (setq index 0 mytools_hidess (ssaddss mytools_hidess ss) )
  (repeat (sslength ss)
    (setq ename (ssname ss index)
          index (1+ index)
          eobj (vlax-ename->vla-object ename)
    )
    (vla-put-visible eobj :vlax-false)
  )
)


(defun ssaddss( ss1 ss2 / flag1 flag2 flag3 ename index)
;;;  (setq flag1 nil flag2 nil flag3 nil)
  (setq index 0)
  (if (and ss1 ss2)
      (repeat (sslength ss2)
        (setq ename (ssname ss2 index)
              index (1+ index)
              ss1 (ssadd ename ss1)
        )
      )
  )

  (if (null ss1) (setq ss1 ss2))
  (if (null ss2) (setq ss1 ss1))

  (if ss1 ss1 nil)
)



;;;;********************************************************************
;;;get the layer_list of the object you selected
(defun get_layer_list(ss / index )
  (setq index 0
        layer_list '()
  )
  (repeat (sslength ss)
    (setq layername (cdr (assoc 8 (entget(ssname ss index))))
          index (1+ index)
    )
    (if (null (member layername layer_list))(setq layer_list(cons layername layer_list)))
  )
  (if layer_list layer_list nil)
)


;;;close the layer_list
(defun close_layer_list(layer_list / index layer)
   (setq index 0)
   (repeat (length layer_list)
     (setq layer (vla-item acadlayers (nth index layer_list)))
     (vla-put-layeron layer :vlax-false)
     (setq index (1+ index))
   )
)



;;;;close layer main function

(defun c:cl(/ layer ss)
  (vl-load-com)
  (princ "\n选择要关闭图层的对象<直接回车打开所有图层>:")
  (setq acadobj (vlax-get-acad-object)
        acaddoc (vla-get-activedocument acadobj)
        acadlayers (vla-get-layers acaddoc)
        ss (ssget)
  )
  (if ss
    (close_layer_list(get_layer_list ss))
    (vlax-for layer acadlayers(vla-put-layeron layer t))
  )
)



(defun open_layer_list(layer_list / index layer)
   (setq index 0)
   (repeat (length layer_list)
     (setq layer (vla-item acadlayers (nth index layer_list)))
     (vla-put-layeron layer t)
     (setq index (1+ index))
   )
)


(defun c:ol(/ layer ss)
  (vl-load-com)
  (princ "\n选择要打开图层的对象<直接回车打开所有图层>:")
  (setq acadobj (vlax-get-acad-object)
        acaddoc (vla-get-activedocument acadobj)
        acadlayers (vla-get-layers acaddoc)
        ss (ssget)
  )
  (if ss
    (progn
      (vlax-for layer acadlayers(vla-put-layeron layer :vlax-false))
      (open_layer_list(get_layer_list ss))
    )
    (vlax-for layer acadlayers(vla-put-layeron layer t))
  )
)

qjcpj

谢谢，收藏了！

sliver610

呵呵，用不上，感谢一下

yoyoho

感谢楼主
收藏了
学习喔!

fill

先谢谢了

男人可贵

楼主好厉害啊,学习了.