多段線的偏移
本帖最后由 lee50310 于 2021-7-20 06:19 编辑花了 一些時間 ，終於寫出來了 如圖，舊版:bb2.lsp(已移除)
;--------------------------------------------------------------------------
感謝兩位大大發現問題 1. 圖層轉換 2. 遇垂直pline線 會出現 除0的錯誤
在修正版 bb3.lsp 已修正更新
最新版bb4.lsp支援圓 , 弧請重新下載
;-------------------------------------------------------------------------
;;bb4.lsp
(defun c:bb4 (/ k j ss ee pt_lst )
(if (= sel nil) (setq sel 10)) ;偏移距離初設 10
(setq of (getdist (strcat "輸入偏移距離:<" (rtos sel) ">")))
(if (= of nil)(setq of sel )(setq sel of))
(if (setq ss (ssget ":s" '((0 . "*POLYLINE,CIRCLE,ARC"))))
(progn
(setq k 0)
(repeat(sslength ss)
(setq ee (ssname ss k))
(setq name (cdr (assoc 0 (entget ee))))
(cond ((= name "CIRCLE") (offset_circle ee))
((= name "ARC") (offset_arc ee)(edit_line))
((= name "LWPOLYLINE") (get_point ee)(offset_line)(edit_line))
)
(setq k (+ k 1))
)
) ;end_progn
(princ "\n沒有選擇對像或選擇的對像不是多段線.")
) ;end_if
) ;end_defun
(prompt "----------------------<<請輸入:bb4 >>-----------------------")
(prin1)
;-----------------------------------------------------------------------------
;繪製圓偏移線
(defun offset_circle (vv / p1)
(setq p1 (cdr (assoc 10 (entget vv))))
(setq r1 (+ (cdr (assoc 40 (entgetvv))) of))
(entmake (list '(0 . "CIRCLE")(cons 8 "LY")(cons 62 1)(cons 10 p1)(cons 40 r1)))
)
;-------------------------------------------------------------------------------
;繪製弧偏移線
(defun offset_arc (vv / p1 p2 p3 p4 p5 r1 ang1 ang2 ang3 ang4)
(setq p1 (cdr (assoc 10 (entget vv))))
(setq r1 (cdr (assoc 40 (entget vv))))
(setq ang1 (cdr (assoc 50 (entget vv))))
(setq ang2 (cdr (assoc 51 (entget vv))))
(setq p2 (polar p1 ang1 r1))
(setq p3 (polar p1 ang2 r1))
(setq p4 (polar p2 ang1 of ))
(setq p5 (polar p3 ang2 of ))
(entmake (list '(0 . "LINE")(cons 8 "LY")(cons 62 1)(cons 10 p2)(cons 11 p4) ))
(entmake (list '(0 . "LINE")(cons 8 "LY")(cons 62 1)(cons 10 p3)(cons 11 p5) ))
(setq ang3 (angle p1 p4)) ;偏移弧起始角度
(setq ang4 (angle p1 p5)) ;偏移弧結束角度
(entmake (list '(0 . "ARC") ;繪製偏移弧
(cons 8 "LY") ;"LY"層
(cons 62 1) ;紅色
(cons 10 p1) ;圓心座標
(cons 40 (+ r1 of)) ;半徑
(cons 50 ang3) ;起始角度
(cons 51 ang4) ;結束角度
)
)
)
;-------------------------------------------------------------------------------
;取多段線頂點型成串列存於 pt_lst中
(defun get_point (vv)
(setq j 0 pt_lst nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam vv) 1))
(setq pt_lst (append pt_lst (list (vlax-curve-getPointAtParam vv j))))
(setq j (1+ j))
)
)
;-------------------------------------------------------------------------------
;繪製多段線偏移線
(defunoffset_line (/ i n p1 p2 p3 p4 ang ang2 )
(setq i 0)
(setq n (- (length pt_lst) 1))
(repeat n
(setq p1 (nth i pt_lst))
(setq p2 (nth (1+ i) pt_lst))
(setq ang (angle p1 p2))
(chack2 ee) ;判斷順逆方向
(if (= order 0)
(setq ang2 (+ ang (* pi 1.5))) ;逆時針
(setq ang2 (+ ang (* pi 0.5))) ;順時針
)
(setq p3 (polar p1 ang2 of ))
(setq p4 (polar p2 ang2 of ))
(progn
(entmake (list '(0 . "LINE")(cons 8 "LY")(cons 62 1)(cons 10 p1)(cons 11 p3) ))
(entmake (list '(0 . "LINE")(cons 8 "LY")(cons 62 1)(cons 10 p2)(cons 11 p4) ))
(entmake (list '(0 . "LINE")(cons 8 "LY")(cons 62 1)(cons 10 p3)(cons 11 p4) ))
)
(setq i (+ i 1))
)
)
;-------------------------------------------------------------------------------
;; 將"LY" 圖層 所有"LINE"線型接合為多段線
(defun edit_line (/ ss ent)
(setvar "cmdecho" 0)
(command "peditaccept" "1") ;轉換成聚合線不顯示提示
(setq ss (ssget "x" '((0 . "LINE,ARC")(8 . "LY"))))
(vl-cmdf "_.pedit" "_m" ss "" "_j" "0.0001" "")
(sssetfirst nil (ssadd (entlast)))
(command "peditaccept" "0") ;顯示提示
(setq ent (entlast))
(princ)
) ;_ end of defun
;-------------------------------------------------------------------------------
;判段多段線順時針或逆時針
(defun chack2 (en/ LW LST MAXP MINP)
(setq lw (vlax-ename->vla-object en ))
(vla-GetBoundingBox lw 'MinP 'MaxP)
(setq
minp (vlax-safearray->list minp)
MaxP (vlax-safearray->list MaxP)
lst
(mapcar
(function
(lambda (x)
(vlax-curve-getParamAtPoint
lw
(vlax-curve-getClosestPointTo lw x)
) ;_ vlax-curve-getParamAtPoint
) ;_ lambda
) ;_ function
(list minp
(list (car minp) (cadr MaxP))
MaxP
(list (car MaxP) (cadr minp))
) ;_ list
) ;_ mapcar
) ;_ setq
(if
(or
(<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
(<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
(<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
(<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
) ;_ or
(setq order 1 ) ;順時針"
(setq order 0 ) ;逆時針"
) ;_ if
(princ)
) ;_ defun
;-------------------------------------------------------------------------------
本帖最后由 lee50310 于 2021-7-20 06:22 编辑
xj6019 发表于 2020-3-13 21:25
我想实现同时向内向外偏移，也可以同时提示向内 向外偏移的数值，图层全部默认当前是最好，往里偏移是虚线 ..依照
依照你的需求,寫好了請測試看看 !新增功能內偏距離輸入內定為5 可自行設定,內偏線為虛線類型程序指定為 "DASHED" , 可改為 "HIDDEN" 或其他類型(註:更改的方式 例:將程序內的所有 "DASHED" 替換為 "HIDDEN" 存檔即可)這個新增內偏功能只對多段線及多邊型的多段線有作用,圓、弧..不起作用 , 其他功能不變 如圖
;
(註: 附件 繁體版,簡體版功能一樣,擇一下載即可)
lee50310 发表于 2020-3-14 23:19
依照你的需求,寫好了請測試看看 !新增功能內偏距離輸入內定為5 可自行設定,內偏線為虛線類型程序指定 ...
(princ "\n⊿Τ匡拒癸钩┪匡拒癸钩ぃ琌琿絬.")
"娩块ず熬簿禯瞒:<"
很多字都是乱码
能不能发个简体版的啊
谢谢 本帖最后由 lee50310 于 2020-3-13 18:52 编辑
xj6019 发表于 2020-3-13 10:16
打扰了，可以把代码增加点吗，直接向内偏移一个固定值，预设定5，可以满足的话，这代码挺适合我用的，有空 ...不懂你的意思?
1.希望程式也能把點考慮進去?這沒辦法,因為很多點在空間中是雜亂無章的 ,事後如何理出順序?
2.還是說把紅色偏移線 改線型為虛線點 ?
真棒，这功能比较实用哦 解释一下，你的图层为何倒腾好几回 啊，你自己有特殊需要吗，直接随层偏移制作不就行嘛
非常好的，谢谢楼主！ 有时出错除数为0
请教何因？
谢谢
ynhh 发表于 2020-3-12 14:58
有时出错除数为0
请教何因？
谢谢
經測試提供的圖檔,發現問題出在判斷順逆時針方向的函數 chack()
若遇到垂直的pline 線 會出現除0 的錯誤 ,在新版 bb3.lsp已修正此問題 ,謝謝你即時發現 xj6019 发表于 2020-3-11 19:40
解释一下，你的图层为何倒腾好几回 啊，你自己有特殊需要吗，直接随层偏移制作不就行嘛
新版 bb3.lsp 已做修正,謝謝你發現問題 很好唷~功能不錯用唷~ 打扰了，可以把代码增加点吗，直接向内偏移一个固定值，预设定5，可以满足的话，这代码挺适合我用的，有空的话，麻烦搞一下，可以不用往你上面代码里面加，放到最后说明一下，如果需要怎么添加就行，别影响你上面的代码，我自己加进去，适合我就行，谢谢！ 圆弧不支持