偏移变色lisp_直线偏移联动 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...

本帖最后由 masterlong 于 2018-11-4 15:08 编辑

;|

类似于edata发布的程序“直线偏移连动~偏移后修改与其相接触的直线”

和他不同的是

edata的程序需要先指定偏移距离，再选择直线，最后指定偏移方向

而我的程序是

先选择参照直线，再选择偏移目标点，直接计算出偏移距离

如果两头都有【同层】线相连，那么参照直线执行偏移

如果仅一头有线相连，那么偏移同时，改变直线到偏移目标点

由于我的应用环境，需要进行如上操作的都是互相垂直的线，所以没加入斜角相交延伸的功能

|;

(vl-load-com)

;;命令是OLL        ————话说，论坛能设置成屏蔽“字母组合自动转表情”吗？？？？

(defun c

ll()

(if (setq ss (ssget":E:S" '((0 . "line"))))

(progn

(command "undo" "g")

(ssdraw ss 3)

(setq pickpt (last (last (car (ssnamex ss)))))  ;;选取点

(setq line (ssname ss 0))

(setq lay (dxf 8 line))

(setq p10 (dxf 10 line))

(setq p11 (dxf 11 line))

(if (< (distance p10 pickpt) (distance p11 pickpt))

(setq pa p10  pb p11)

(setq pa p11  pb p10)

)

(zooment line 2)

(setq ss1 (ssget "F" (list p10 p11) (list '(0 . "line") (cons 8 lay))))

(setq ss1 (ss2list ss1))

(setq ss1 (vl-remove line ss1))

(command "_.zoom" "p")

(ssdraw ss1 3)

(if (setq pc (getpoint pa "\n指定偏移点: "))

(progn

(setq yn (vl-remove-if-not ''((one) (or (equal (distance (dxf 10 one) pa) 0 5) (equal (distance (dxf 11 one) pa) 0 5))) ss1))

(do_offset)

)

)

(ssdraw ss  4)

(ssdraw ss1 4)

(command "undo" "e")

(c

ll)

)

)

(princ)

)

(defun do_offset()

(setq ang (angle pa pc))

(setq dist (distance pa pc))

(setq pd (polar pb ang dist))

(setq pd (per_po pb pc pd))

(if yn

(setq pc (per_po pa pc pd))

)

(entmodone line 10 pc)

(entmodone line 11 pd)

;|

(setq pa (list (car pa) (cadr pa)))

(setq pb (list (car pb) (cadr pb)))

(setq pc (list (car pc) (cadr pc)))

(setq pd (list (car pd) (cadr pd)))

|;

(foreach linef ss1

(setq pm (dxf 10 linef)

pn (dxf 11 linef)

)

;;(setq pm (list (car pm) (cadr pm)))

;;(setq pn (list (car pn) (cadr pn)))

(setq px (inters pa pb pm pn NIL))

(cond

((equal (distance pm px) 0 5)  (setq dxfnm 10))

((equal (distance pn px) 0 5)  (setq dxfnm 11))

( T (setq dxfnm NIL))

)

(setq px (inters pc pd pm pn NIL))

(if (and px dxfnm)

(entmodone linef dxfnm px)

)

)

)

;;公共函数

;999获取图元某个dxf组码

(defun dxf( ent n / temp )

(if (and (= (type ent) 'int) (= (type n) 'ename))

(setq temp  ent

ent n

n  temp

)

)

(cdr (assoc n (entget ent)))

)

;999按指定的模式重画一个选择集的全部物体4=1->2->4)>    【支持模型多视口，支持布局中视口】

;;  1:显示  2:消隐  3:高亮  4:低亮

(defun ssdraw( ss mode / i ent )

(if (= (strcase (getvar "ctab")) "MODEL")

(if (member mode '(1 2 3 4))

(foreach vp (reverse (vports))

(setvar "cvport" (car vp))

(cond

((= (type ss) 'PICKSET)

(foreach ent (ss2list ss)

(redraw ent mode)

)

)

((= (type ss) 'list)

(foreach ent ss

(redraw ent mode)

)

)

((= (type ss) 'ename)

(redraw ss mode)

)

)

)

)

(cond

((= (type ss) 'PICKSET)

(foreach ent (ss2list ss)

(redraw ent mode)

)

)

((= (type ss) 'list)

(foreach ent ss

(redraw ent mode)

)

)

((= (type ss) 'ename)

(redraw ss mode)

)

)

)

(princ)

)

;999以指定图元缩放窗口

(defun zooment( ent sc / box x midpo )

(setq *acad*      (vlax-get-acad-object))

(setq box (entbox ent))

(setq midpo (getmidpo box))

(setq box (mapcar '(lambda (x) (p0_sc_p1 midpo x sc)) box))

(vla-zoomwindow *acad* (vlax-3d-point (car box)) (vlax-3d-point (cadr box)))

box

)

;999以基点p0缩放p1————P0为缩放基点

(defun p0_sc_p1 (p0 p1 sc )

(polar p0 (angle p0 p1) (* sc (distance p0 p1)))

)

;999修改一个图元的某个数据   ——————不是所有的图元都适用此方式

(defun entmodone( ent dxfnum data )

(entmod (list (cons -1 ent)(cons dxfnum data)))

)

;999一点到另两点形成直线的垂足

(defun per_po( p1 p2 p3 / ang ptemp )

(setq ang (angle p2 p3))

(setq ang (+ ang (/ PI 2)))

(setq ptemp (polar p1 ang 1000))

(inters p1 ptemp p2 p3 nil)

)

漏了一些子函数见7楼