仅偏移clo的一部分
大家好，我有一个lisp创建双黄线的道路标线。lisp中有2个选项。1： 选择要偏移的线以创建黄线，或2：沿要偏移的线绘制以创建线。我通常绘制闭合多段线来表示人行道的一段，因此对于所选选项，我希望选择两个点，在这两个点之间，线是偏移的，而不是整个闭合多段线。有人能帮我吗？
(defun C:RRM008 (/ ang coords elist midp offsetted offsetted1 ofpt p1 p2 p3 pline side SUCE SUOM SUSM SUAB SUAD SUCL SUCR)
(setq SUCE (getvar "cmdecho"))
(setq SUOM (getvar "orthomode"))
(setq SUSM (getvar "osmode"))
(setq SUAB (getvar "angbase"))
(setq SUAD (getvar "angdir"))
(setq SUCL (getvar "clayer"))
(setq SUCR (getvar "cecolor"))
;(command "_.-layer" "_N" "CCC_LAYOUT_Proposed_Road_Lining_Yellow_RRM008" "_C" "2" "CCC_LAYOUT_Proposed_Road_Lining_Yellow_RRM008" "" )
(setq vl1 (list
(cons 0 "LAYER") ;Name of entity
(cons 100 "AcDbSymbolTableRecord") ;Open Records
(cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
(cons 2 "CCC_LAYOUT_Proposed_Road_Lining_Yellow_RRM008") ;Name of Layer
(cons 6 "Continuous") ;Linetype
(cons 62 2) ;colour = light grey
(cons 70 0) ;state
(cons 290 1) ;1=plot, 0=Don't plot
) ;End of entity list
)
(entmake vl1)
(setvar "clayer" "CCC_LAYOUT_Proposed_Road_Lining_Yellow_RRM008")
(command "._-linetype""s""bylayer" "")
(setvar "cecolor" "1")
(initget "D S")
(setq option (getkword "\nChoose Draw line or Select line method: : "))
(cond ((= option "D")(yellow_draw_01))
((= option "S")(yellow_select_01))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun yellow_select_01 ()
(setq pline(entsel "\nSelect a kerb line: "))
(yellow_resume)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun yellow_draw_01 ()
(princ "\nDraw a kerb line: ")
(setvar "cecolor" "1")
(command "._pline")
(while (= 1 (logand 1 (getvar "cmdactive")))
(command pause))
(setq pline (entlast)
elist (entget pline)
)
(setvar "cecolor" "Bylayer")
(yellow_resume)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun yellow_resume ()
(setq side(getpoint "\nPick an offset side: "))
(command "._offset" 0.3 pline side "")
(setq offsetted (entlast)
elist (entget offsetted)
)
(entmod elist)
(command "._pedit" offsetted "_W" 0.1 "")
(setq coords (vl-remove-if (function not)
(mapcar (function (lambda (x)
(if (= 10 (car x))(cdr x))))
elist))
)
(setq p2 (car coords)
midp (mapcar (function (lambda( a b)(/ (+ a b) 2)))
p1 p2)
)
(command "_change" offsetted """p" "Layer" "CCC_LAYOUT_Proposed_Road_Lining_Yellow_RRM008" "color" "Bylayer" "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "._offset" 0.5 pline side "")
(setq offsetted1 (entlast)
elist (entget offsetted1)
)
(entmod elist)
(command "._pedit" offsetted1 "_W" 0.1 "")
(setq coords (vl-remove-if (function not)
(mapcar (function (lambda (x)
(if (= 10 (car x))(cdr x))))
elist))
)
(setq p2 (car coords)
midp (mapcar (function (lambda( a b)(/ (+ a b) 2)))
p1 p2)
)
(command "_change" offsetted1 """p" "Layer" "CCC_LAYOUT_Proposed_Road_Lining_Yellow_RRM008" "color" "Bylayer" "")
(cond ((= option "D")(command "_erase" pline "" ))
)
(setvar "cmdecho" SUCE)
(setvar "orthomode" SUOM)
(setvar "osmode" SUSM)
(setvar "angbase" SUAB)
(setvar "angdir" SUAD)
(setvar "clayer" SUCL)
(setvar "cecolor" SUCR)
(princ)
) 我看过李的代码，但我不知道如何合并它。谁能给我指路吗。我需要将两条线偏移到一边。
http://www.lee-mac.com/offsetpolysection.html 尝试放置
在代码的早期，并用
(c:offsec) 好啊汤布。谢谢
李，我要把什么设置改成只在一边偏移？ 有人能帮我吗，也许是李？我正在尝试将李的OffSetSection调整为只对一方进行补偿，但我需要引入一个部分来询问哪一方，但我在这方面做得很失败。 由于vla offset与offset命令的工作方式不同，因此可能很难按照您想要的方式进行修改。难道删除你不想要的那一面不像选择你想要的那一面那么容易吗？这样，当你需要它时，它也可以工作到两边。 我相信你是指这样的事情。有人可以添加一些代码，让你选择抵消哪一边，但我没有时间
;;------------------=={ Offset LWPolyline Section }==-------------------;;
;; ;;
;;This program prompts the user to specify an offset distance and to;;
;;select an LWPolyline. The user is then prompted to specify two ;;
;;points on the LWPolyline enclosing the section to be offset. The ;;
;;progam will proceed to offset all segments between the two given ;;
;;points to both sides by the specified distance. ;;
;; ;;
;;The program is compatible with LWPolylines of constant or varying ;;
;;width, with straight and/or arc segments, and defined in any UCS ;;
;;construction plane. ;;
;;----------------------------------------------------------------------;;
;;Author:Lee Mac, Copyright © 2013-www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
;;Version 1.0 - 27-12-2012 ;;
;; ;;
;;First release. ;;
;;----------------------------------------------------------------------;;
;;Version 1.1 - 05-04-2013 ;;
;; ;;
;;Fixed bug when offsetting polyline arc segments. ;;
;;----------------------------------------------------------------------;;
;;Slightly edited By: CB (Sorry Lee-Mac)
(defun c:offsec ( / d e h l m n o p q w x z )
(if (null *off*)
(setq *off* 1.0)
)
(initget 6)
(if (setq d (getdist (strcat "\nSpecify Offset <" (rtos *off*) ">: ")))
(setq *off* d)
(setq d *off*)
)
(while
(progn (setvar 'errno 0) (setq e (car (entsel "\nSelect LWPolyline: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null e) nil)
( (/= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
(princ "\nObject is not an LWPolyline.")
)
( (setq p (getpoint "\nSpecify 1st Point: "))
(setq p (vlax-curve-getclosestpointto e (trans p 1 0)))
(while
(and
(setqq (getpoint (trans p 0 1) "\nSpecify 2nd Point: "))
(equal p (setq q (vlax-curve-getclosestpointto e (trans q 1 0))) 1e-
)
(princ "\nPoints must be distinct.")
)
(if q
(progn
(if (> (setq m (vlax-curve-getparamatpoint e p))
(setq n (vlax-curve-getparamatpoint e q))
)
(mapcar 'set '(m n p q) (list n m q p))
)
(setq e (entget e)
h (reverse (member (assoc 39 e) (reverse e)))
h (subst (cons 70 (logand (cdr (assoc 70 h)) (~ 1))) (assoc 70 h) h)
l (LM:LWVertices e)
z (assoc 210 e)
)
(repeat (fix m)
(setq l (cdr l))
)
(if (not (equal m (fix m) 1e-)
(setq x (car l)
w (cdr (assoc 40 x))
l
(cons
(list
(cons10 (trans p 0 (cdr z)))
(cons40 (+ w (* (- m (fix m)) (- (cdr (assoc 41 x)) w))))
(assoc 41 x)
(cons42
(tan
(*(- (min n (1+ (fix m))) m)
(atan (cdr (assoc 42 x)))
)
)
)
)
(cdr l)
)
)
)
(setq l (reverse l))
(repeat (+ (length l) (fix m) (- (fix n)) -1)
(setq l (cdr l))
)
(if (not (equal n (fix n) 1e-)
(setq x (car l)
w (cdr (assoc 40 x))
l
(vl-list*
(list
(cons 10 (trans q 0 (cdr z)))
'(40 . 0.0)
'(41 . 0.0)
'(42 . 0.0)
)
(list
(assoc 10 x)
(assoc 40 x)
(cons41
(+ w
(*(/ (- n (max m (fix n))) (- (1+ (fix n)) (max m (fix n))))
(- (cdr (assoc 41 x)) w)
)
)
)
(cons42
(tan
(*(if (< (fix n) m) 1.0 (- n (fix n)))
(atan (cdr (assoc 42 x)))
)
)
)
)
(cdr l)
)
)
)
(setq o
(vlax-ename->vla-object
(entmakex (append h (apply 'append (reverse l)) (list z)))
)
)
(vl-catch-all-apply 'vla-offset (list o d))
(vl-catch-all-apply 'vla-offset (list o (* 2 d)))
(vla-delete o)
)
)
)
)
)
)
(princ)
)
;; Tangent-Lee Mac
;; Args: x - real
(defun tan ( x )
(if (not (equal 0.0 (cos x) 1e-)
(/ (sin x) (cos x))
)
)
;; LW Vertices-Lee Mac
;; Returns a list of lists in which each sublist describes the position,
;; starting width, ending width and bulge of a vertex of an LWPolyline
(defun LM:LWVertices ( e )
(if (setq e (member (assoc 10 e) e))
(cons
(list
(assoc 10 e)
(assoc 40 e)
(assoc 41 e)
(assoc 42 e)
)
(LM:LWVertices (cdr e))
)
)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: OffsetSection.lsp | Version 1.1 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Type \"offsec\" to Invoke ::"
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;; 我不喜欢更改李的代码，因为他会做得更好。 所有这些都是同样的原因，但你让我这么做：
;|------------------=={ Offset LWPolyline Section }==-------------------
This program prompts the user to specify an offset distance and to
select an LWPolyline. The user is then prompted to specify two
points on the LWPolyline enclosing the section to be offset. The
progam will proceed to offset all segments between the two given
points to both sides by the specified distance.
The program is compatible with LWPolylines of constant or varying
width, with straight and/or arc segments, and defined in any UCS
construction plane.
----------------------------------------------------------------------
Author:Lee Mac, Copyright © 2013-www.lee-mac.com
----------------------------------------------------------------------
Version 1.0 - 27-12-2012
First release.
----------------------------------------------------------------------
Version 1.1 - 05-04-2013
Fixed bug when offsetting polyline arc segments.
----------------------------------------------------------------------
Version 1.2 - 06-09-2015
Added prompt to select side to offset.Tom Beauford
----------------------------------------------------------------------|;
(defun c:offsec ( / d e h l m n o p q w x z )
(if (null *off*)
(setq *off* 1.0)
)
(initget 6)
(if (setq d (getdist (strcat "\nSpecify Offset <" (rtos *off*) ">: ")))
(setq *off* d)
(setq d *off*)
)
(while
(progn (setvar 'errno 0) (setq e (car (entsel "\nSelect LWPolyline: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null e) nil)
( (/= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
(princ "\nObject is not an LWPolyline.")
)
( (setq p (getpoint "\nSpecify 1st Point: "))
(setq p (vlax-curve-getclosestpointto e (trans p 1 0)))
(while
(and
(setqq (getpoint (trans p 0 1) "\nSpecify 2nd Point: "))
(equal p (setq q (vlax-curve-getclosestpointto e (trans q 1 0))) 1e-
)
(princ "\nPoints must be distinct.")
)
(if q
(progn
(if (> (setq m (vlax-curve-getparamatpoint e p))
(setq n (vlax-curve-getparamatpoint e q))
)
(mapcar 'set '(m n p q) (list n m q p))
)
(setq e (entget e)
h (reverse (member (assoc 39 e) (reverse e)))
h (subst (cons 70 (logand (cdr (assoc 70 h)) (~ 1))) (assoc 70 h) h)
l (LM:LWVertices e)
z (assoc 210 e)
)
(repeat (fix m)
(setq l (cdr l))
)
(if (not (equal m (fix m) 1e-)
(setq x (car l)
w (cdr (assoc 40 x))
l
(cons
(list
(cons10 (trans p 0 (cdr z)))
(cons40 (+ w (* (- m (fix m)) (- (cdr (assoc 41 x)) w))))
(assoc 41 x)
(cons42
(tan
(*(- (min n (1+ (fix m))) m)
(atan (cdr (assoc 42 x)))
)
)
)
)
(cdr l)
)
)
)
(setq l (reverse l))
(repeat (+ (length l) (fix m) (- (fix n)) -1)
(setq l (cdr l))
)
(if (not (equal n (fix n) 1e-)
(setq x (car l)
w (cdr (assoc 40 x))
l
(vl-list*
(list
(cons 10 (trans q 0 (cdr z)))
'(40 . 0.0)
'(41 . 0.0)
'(42 . 0.0)
)
(list
(assoc 10 x)
(assoc 40 x)
(cons41
(+ w
(*(/ (- n (max m (fix n))) (- (1+ (fix n)) (max m (fix n))))
(- (cdr (assoc 41 x)) w)
)
)
)
(cons42
(tan
(*(if (< (fix n) m) 1.0 (- n (fix n)))
(atan (cdr (assoc 42 x)))
)
)
)
)
(cdr l)
)
)
)
(setq p (getpoint "Specify point on side to offset or Enter for both: ")
o (vlax-ename->vla-object(entmakex (append h (apply 'append (reverse l)) (list z))))
ename (vlax-vla-object->ename o)
)
(if p
(progn
(princ "\nPoint selected!")
(command "_.offset" d ename p "")
(entdel ename)
)
(progn
(princ "\nPoint NOT selected!")
; (vlax-ename->vla-object o)
; (setq o (vlax-ename->vla-object(entmakex (append h (apply 'append (reverse l)) (list z)))))
(vl-catch-all-apply 'vla-offset (list o d))
(vl-catch-all-apply 'vla-offset (list o (- d)))
(vla-delete o)
)
)
)
)
)
)
)
)
(princ)
)
;; Tangent-Lee Mac
;; Args: x - real
(defun tan ( x )
(if (not (equal 0.0 (cos x) 1e-)
(/ (sin x) (cos x))
)
)
;; LW Vertices-Lee Mac
;; Returns a list of lists in which each sublist describes the position,
;; starting width, ending width and bulge of a vertex of an LWPolyline
(defun LM:LWVertices ( e )
(if (setq e (member (assoc 10 e) e))
(cons
(list
(assoc 10 e)
(assoc 40 e)
(assoc 41 e)
(assoc 42 e)
)
(LM:LWVertices (cdr e))
)
)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: OffsetSection.lsp | Version 1.1 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Type \"offsec\" to Invoke ::"
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;
对不起，李无意冒犯，添加了选项“指定要偏移的边上点或同时输入” 谢谢Tombu。这太棒了。如果我有一条闭合多段线，并且我选择了两个点进行偏移，那么例程如何知道要偏移闭合多段线的哪一部分？对不起，我现在有点挑剔！！
页:
[1]
2