664571221 发表于 2018-9-17 10:55:11

求把一下程序线的宽度改为60，颜色改为211

(defun c:tt(/ ess p1 p2 pstart ang dist midp vla_e)

(setq ess(ssadd))
(setq p1(getpoint "\n起始点")
        pstart p1
        )
(while (setq p2(getpoint p1 "\n下一点"))
    (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
    (setq ess(ssadd (entlast) ess))
    (setq ang(angle p1 p2)
          dist(distance p1 p2)
          midp(polar p1 ang (/ dist 2))
          )
    (if (<(car p2)(car p1))(setq ang (+ pi ang)))
    (setq midp(polar midp (+ ang (/ pi 2)) 2.5))
    (entmake (list '(0 . "TEXT") (cons 1 (strcat "L=" (rtos (/ dist 1000.) 2 2) "m")) (cons 10 '(0 0 0))
                   (cons 11 midp) (cons 40 200)(cons 50 ang)(cons 62 3)(cons 72 1))
             )
    (setq p1 p2)
    )
(command "_.pedit" "_m" ess "" "Y" "J""" "")
(setq vla_e(vlax-ename->vla-object (entlast)))
(if (equal pstart p1 1e-3)
    (progn
      (vla-getboundingbox vla_e 'p1 'p2)
      (setq p1(vlax-safearray->listp1 )
          p2(vlax-safearray->listp2 )
          midp(mapcar (function (lambda (e1 e2) (* (+ e1 e2) 0.5))) p1 p2)
      )
    (entmake (list '(0 . "TEXT") (cons 1 (strcat "A=" (rtos (/ (vla-get-area vla_e) 1e6) 2 2) "m2")) (cons 10 '(0 0 0))
                   (cons 11 midp) (cons 40 200)(cons 50 0)(cons 62 4)(cons 72 1))
             )
    )
    )
(princ)
)

tranney 发表于 2018-9-17 14:43:57

(defun c:tt(/ ess p1 p2 pstart ang dist midp vla_e)

(setq ess(ssadd))
(setq p1(getpoint "\n起始点")
      pstart p1
      )
(while (setq p2(getpoint p1 "\n下一点"))
    ;(entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
                  (entmake (list '(0 . "LWPOLYLINE")
           '(100 . "AcDbEntity")
           '(100 . "AcDbPolyline")   
           '(62 . 211)       ;颜色
           '(90 . 12)
           '(70 . 1)
           (cons 10 p1)
           '(40 . 60)      ;线宽
           '(41 . 60)      ;线宽
           (cons 10 p2)))
    (setq ess(ssadd (entlast) ess))
    (setq ang(angle p1 p2)
          dist(distance p1 p2)
          midp(polar p1 ang (/ dist 2))
          )
    (if (<(car p2)(car p1))(setq ang (+ pi ang)))
    (setq midp(polar midp (+ ang (/ pi 2)) 2.5))
    (entmake (list '(0 . "TEXT") (cons 1 (strcat "L=" (rtos (/ dist 1000.) 2 2) "m")) (cons 10 '(0 0 0))
                   (cons 11 midp) (cons 40 200)(cons 50 ang)(cons 62 3)(cons 72 1))
             )
    (setq p1 p2)
    )
(command "_.pedit" "_m" ess "" "Y" "J""" "")
(setq vla_e(vlax-ename->vla-object (entlast)))
(if (equal pstart p1 1e-3)
    (progn
      (vla-getboundingbox vla_e 'p1 'p2)
      (setq p1(vlax-safearray->listp1 )
            p2(vlax-safearray->listp2 )
            midp(mapcar (function (lambda (e1 e2) (* (+ e1 e2) 0.5))) p1 p2)
      )
    (entmake (list '(0 . "TEXT") (cons 1 (strcat "A=" (rtos (/ (vla-get-area vla_e) 1e6) 2 2) "m2")) (cons 10 '(0 0 0))
                   (cons 11 midp) (cons 40 200)(cons 50 0)(cons 62 4)(cons 72 1))
             )
    )
    )
(princ)
)

tranney 发表于 2018-9-17 14:47:27

对了，(command "_.pedit" "_m" ess "" "Y" "J""" "")这个代码最好是改成
;(command "_.pedit" "_m" ess "" "Y" "J""" "")

664571221 发表于 2018-9-17 14:56:37

tranney 发表于 2018-9-17 14:47
对了，(command "_.pedit" "_m" ess "" "Y" "J""" "")这个代码最好是改成
;(command "_.pedit" "_m" ess ...

你好 谢谢你，非常感谢

664571221 发表于 2018-9-17 16:42:04

tranney 发表于 2018-9-17 14:47
对了，(command "_.pedit" "_m" ess "" "Y" "J""" "")这个代码最好是改成
;(command "_.pedit" "_m" ess ...

你好本来闭合后是有面积的，你这个怎么没有了
页: [1]
查看完整版本: 求把一下程序线的宽度改为60，颜色改为211