《剪切成虚线》v3.1版(支持框选)

gcho

测试很强大，可以解决这种问题吗，已知直线AC，B点为直线AC的中点，想把另一条直线BC改为虚线，同时裁剪删除直线AC的BC段吗？

qiushizhda

这个功能很实用

xzs0829

攒攒赞

gzbccy

看看狼大师的新作

anywn1980

感谢langjs分享，谢谢

langjs

gcho 发表于 2018-11-5 11:09
测试很强大，可以解决这种问题吗，已知直线AC，B点为直线AC的中点，想把另一条直线BC改为虚线，同时裁剪删 ...

这个有啥用呢？有源码了很容易就改出来
(defun c:qq ( / code en ent gr i loop name nearpt p0 p1 p2 pd pdlst pt ss x)
  (defun sub (i x ent)               
    (subst(cons i x)(assoc i ent) ent))
  (setvar "cmdecho" 0)               
  (if (null (tblsearch "ltype" "DASHED")) (command "-linetype" "L" "DASHED" "" ""))
  (if (= (tblsearch "layer" "4虚线层") nil)
    (command "layer" "new" "4虚线层" "c" 6 "4虚线层" "lt" "DASHED" "4虚线层" ""))
  (setq loop t pdlst nil pd nil )
  (princ "\n请指定对象,[右键]退出:")
  (while loop
    (setq gr (grread t 15 2) code (car gr) pt (cadr gr))
    (cond
      ((= code 3)      
        (if pd  (setq pdlst nil  pd nil)))
      ((or (= code 11) (= code 25))                             
        (if pd (progn (princ "\n请指定对象,[右键]退出:") (entdel (car pdlst))
            (setq pdlst nil  pd nil )) (setq loop nil) ) )
      ((= code 5)
        (if (setq nearpt (osnap pt "_NEA"))
          (if (and (not pd) (setq ss (ssget "C" nearpt nearpt '((0 . "LINE"))))
                (setq name (ssname ss 0)) (setq ent (entget name))
                (not (member name pdlst)) )
            (progn
              (princ "\n[左键]确认,[右键]删除")
              (setq pdlst (cons name pdlst) p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))
              (if (< (distance nearpt p2) (distance nearpt p1))
                (setq p0 p2  p2 p1  p1 p0 ))
              (setq p0 (polar p1 (angle p1 p2) (* 0.5 (distance p1 p2)))
                    ent (sub 10 p0 ent)ent (sub 11 p2 ent))(entmod ent)
              (setq en (cdr ent) en (sub 10 p1 en) en (sub 11 p0 en))
              (entmake (sub 8 "4虚线层" en))
              (setq pd "Y" pdlst (cons (entlast) pdlst))))
          (if pd (progn (princ "\n请指定对象,[右键]退出:") (entdel (car pdlst))
              (setq ent (entget (last pdlst))  ent (sub 10 p1 ent)
                    ent (sub 11 p2 ent))(entmod ent)
              (setq pdlst nil  pd nil) ))))))
  (princ)
)

xiewu

虽然少用，支持一下

Nico

实用且牛B，牛牛牛

13648893846

回复向大师学习

kexiya123

这么牛B的操作，确实值得学习！