双折线绘制

langjs

;;; ****************************************************************
;;; 双折线绘制(支持直线和多段线)
;;; ****************************************************************
(defun c:szx (/ #erryx001 $orr a b c co curve d en ent h i l la lst name obj p p0 p10 p11 pp r snap ty x)
  (defun #erryx001 (s)
    (setvar "osmode" snap) (command ".UNDO" "E") (setq *error* $orr))
  (defun hh:pickarc (curve p / pp)
    (setq pp (vlax-curve-getclosestpointto curve (trans p 1 0)))
    (setq pp (vlax-curve-getsecondderiv curve (fix (vlax-curve-getparamatpoint curve pp))))
    (equal pp '(0.0 0.0 0.0))  )
  (defun rf (r / pp) (* (/ r 180.0) pi))
  (vl-load-com)
  (setvar "cmdecho" 0)
  (setq $orr *error*)
  (setq *error* #erryx001)
  (command ".UNDO" "BE")
  (setq snap (getvar "osmode"))
  (setvar "osmode" 0)
  (while (setq en (entsel "\n选择直线段:"))
    (setq name (car en) p0 (cadr en) p0 (osnap p0 "_NEA") ent (entget name) ty (cdr (assoc 0 ent)) la (assoc 8 ent))
    (if (not (setq co (assoc 62 ent))) (setq co (assoc 62 (tblsearch "layer" (cdr la)))))
    (if (= ty "LWPOLYLINE")
      (if (hh:pickarc name p0)
        (progn
          (setq lst '()        obj (vlax-ename->vla-object name)
                i (fix (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj p0))))
          (foreach x ent  (if (= (car x) 10) (setq lst (cons (cdr x) lst))))
          (setq lst (reverse lst) p10 (nth i lst)
                p11 (nth (if (< (1+ i) (length lst)) (1+ i)  0 ) lst ) ty "LINE")))
      (if (= ty "LINE")
        (setq p10 (cdr (assoc 10 ent))  p11 (cdr (assoc 11 ent)))))
    (if (= ty "LINE")
      (progn
        (setq r (angle p10 p11) h (* (getvar "DIMTXT") (getvar "DIMSCALE")) l (/ h (sin (rf 75)))
              a (polar p0 (+ r (rf 105)) l) b (polar p0 (- r (rf 75)) l)
              c (polar a (- r (rf 105)) l) d (polar b (+ r (rf 75)) l))
        (if (and
              (equal (+ (distance c p10) (distance c p11)) (distance p10 p11) 0.000001)
              (equal (+ (distance d p10) (distance d p11)) (distance p10 p11) 0.000001) )
          (progn
            (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") la co (cons 90 4) (cons 10 c)
                           (cons 10 a) (cons 10 b) (cons 10 d)))
            (setq en (entlast))
            (command "trim" en "" "F" (polar p0 (+ r (rf 179)) (* 0.267 h)) (polar p0 (+ r (rf 181)) (* 0.267 h)) "" "F"
                     (polar p0 (+ r (rf 1)) (* 0.267 h)) (polar p0 (- r (rf 1)) (* 0.267 h)) "" ""))))))
  (setvar "osmode" snap)
  (command ".UNDO" "E")
  (setq *error* $orr)
  (princ)
)

masterlong

缩放到很小没有误选
其实是缩放的不够小
第一次用之前没看代码
用了以后我直接懵了
点一下直线短了半截
再点一下又短了半截
后面看了代码
才知道是咋回事

以标注字高定大小
也不是特别合理
因为有的人用专业软件标注
而我几乎不用标注
所以默认标注字高可能就是0.18

其实我也很少用到折线这功能
需要时就手动画一个
反馈下我的体验没有其它意思

langjs

masterlong 发表于 2022-5-26 23:09
设的折线太小了
没缩放窗口的情况下
trim会误选

大小是根据当前标注的字高自动调节的。关闭了捕捉缩放很小也没有误选啊

xj6019

感谢大神又分享佳作

masterlong

设的折线太小了
没缩放窗口的情况下
trim会误选

罗尼

langjs大师的作品都是很实用的

lxl217114

谢谢langjs大师分享新作

999999

感谢大神分享的新作

蓦然语嫣

谢谢大神的分享

wangsr

谢谢分享，不错