将单线转换为双线乐筑天下 - Powered by Discuz! Archiver

akgbmb 发表于 2022-7-5 16:49:18

将单线转换为双线

你好
新年快乐

我正在寻找将选择线转换为双线的命令。选择线应在输入值的一半处偏移到两侧，选择线应删除。列表需要遵循以下方式

命令：
>选择行：
>线间距：

请支持我
阿比拉什

Tharwat 发表于 2022-7-5 17:04:06

试试这个：
(defun c:Test ( / ss of in sn )
;; Tharwat - 03.Jan.2017 ;;
(if (and (setq ss (ssget "_:L" '((0 . "LINE"))))
      (setq of (getdist "\nSpecify offset distance :"))
      )
(while (setq sn (ssname ss 0))
(mapcar '(lambda (d)
            (vlax-invoke (vlax-ename->vla-object sn) 'offset (eval d)))
   '((/ of 2.) (- (/ of 2.)))
   )
(ssdel sn ss)
(entdel sn)
)
)
(princ)
) (vl-load-com)

David Bethel 发表于 2022-7-5 17:13:23

在Vanilla AutoLisp中：

(defun c:dline (/ od hd ss i en ed p1 p2 an a9 lt tk cl)

(initget 6)
(setq od (getdist (strcat "\nOffset Distance <" (rtos (getvar "OFFSETDIST") 2 2) ">:")))

(or od (setq od (getvar "OFFSETDIST")))
(setq hd (* od 0.5))
(setvar "OFFSETDIST" od)

(while (setq ss (ssget '((0 . "LINE"))))
   (setq i 0)
   (while (setq en (ssname ss i))
            (setq ed (entget en)
                  p1 (cdr (assoc 10 ed))
                  p2 (cdr (assoc 11 ed))
                  an (angle p1 p2)
                  a9 (* pi 0.5)
                  lt (if (assoc6 ed) (cdr (assoc6 ed)) "BYLAYER")
                  tk (if (assoc 39 ed) (cdr (assoc 39 ed)) 0)
                  cl (if (assoc 62 ed) (cdr (assoc 62 ed)) 256))
            (entmake (list (assoc 0 ed)
                           (cons 6 lt)
                           (assoc 8 ed)
                           (cons 10 (polar p1 (+ an a9) hd))
                           (cons 11 (polar p2 (+ an a9) hd))
                           (cons 39 tk)
                           (cons 62 cl)
                           (assoc 210 ed)))
            (entmake (list (assoc 0 ed)
                           (cons 6 lt)
                           (assoc 8 ed)
                           (cons 10 (polar p1 (- an a9) hd))
                           (cons 11 (polar p2 (- an a9) hd))
                           (cons 39 tk)
                           (cons 62 cl)
                           (assoc 210 ed)))
            (entdel en)
            (setq i (1+ i))))
(redraw)
(prin1))

-大卫

akgbmb 发表于 2022-7-5 17:15:48

谢谢老板。。。。。它真正的支持。。。。它正在工作

akgbmb 发表于 2022-7-5 17:31:16

尊敬的David Bethel和Tharwat

你的Lisp程序有效。两个lisp对我都很有用谢谢你的支持

Tharwat 发表于 2022-7-5 17:33:56

很乐意帮忙-非常欢迎你。

Lee Mac 发表于 2022-7-5 17:49:12

以下是另一种与平行于WCS平面的UCS平面兼容的方法：
;; Line to Double-Line-Lee Mac

(defun c:l2dl ( / dis enx hed idx lst sel tmp vec )
(if (minusp (setq dis (getvar 'offsetdist))) (setq dis 1.0))
(initget 6)
(if (setq tmp (getdist (strcat "\nSpecify line separation <" (rtos dis) ">: ")))
   (setvar 'offsetdist (setq dis tmp))
)
(setq dis (/ dis 2.0))
(if (setq sel (ssget "_:L" '((0 . "LINE"))))
   (repeat (setq idx (sslength sel))
      (setq enx (entget (ssname sel (setq idx (1- idx))))
            hed (cons '(0 . "LINE") (LM:defaultprops enx))
            lst (mapcar '(lambda ( k ) (cdr (assoc k enx))) '(10 11))
            vec (apply 'mapcar (cons '- lst))
            lst (mapcar '(lambda ( x ) (trans x 0 vec)) lst)
      )
      (repeat 2
            (entmake (append hed (mapcar '(lambda ( a b ) (cons a (trans (cons (+ dis (car b)) (cdr b)) vec 0))) '(10 11) lst)))
            (setq dis (- dis))
      )
      (entdel (cdr (assoc -1 enx)))
   )
)
(princ)
)

;; Default Properties-Lee Mac
;; Returns a list of DXF properties for the supplied DXF data,
;; substituting default values for absent DXF groups

(defun LM:defaultprops ( enx )
(mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ( x )))
   '(
      (006 . "BYLAYER")
      (008 . "0")
      (039 . 0.0)
      (048 . 1.0)
      (062 . 256)
      (370 . -1)
   )
)
)

(princ)

BIGAL 发表于 2022-7-5 17:56:24

这是我们一直在为预设尺寸做的事情。

; pipe offset for different size pipes
; by Alan H July 2014
(vl-load-com)
(defun existLinetype (LineTypeName / item loaded)
(setqdoc (vla-get-activedocument (vlax-get-acad-object))) ; open database
(vlax-for item (vla-get-linetypes doc)
(if (= (strcase (vla-get-name item)) (strcase LineTypeName))
(setq loaded T)
)
)
(if (= Loaded T)
(princ "loaded")
(command "-linetype" "L" LineTypeName "P:\\AUTODESK\\SUPPORTFILES\\CUSTOM.LIN" "")
)
)
(existLinetype "EX_PIPE250")
(defun pipeoffset (w / ang stpt pt3 pt4 obj whatis)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq obj (entsel "\nPick line"))
(setq objtype (vla-get-objectname (vlax-ename->vla-object (car obj))))
(if (= "AcDbLINE" objtype)
(progn
(alert "You have picked an object which is not a line\nTry Again")
(exit)
)
(princ "\nLine")
)
(setq stpt (assoc 10 (entget (car obj))))
(setq stpt (list (nth 1 stpt)(nth 2 stpt)))
(setq endpt (assoc 11 (entget (car obj))))
(setq endpt (list (nth 1 endpt)(nth 2 endpt)))
(setq ang (angle stpt endpt))
(setq pt3 (polar stpt (+ ang (/ pi 2.0)) 1.0))
(setq pt4 (polar stpt (- ang (/ pi 2.0)) 1.0))
(command "offset" w obj pt3 "")
(Command "chprop" "last" "" "LT" "EX_PIPE250" "")
(command "offset" w obj pt4 "")
(Command "chprop" "last" "" "LT" "EX_PIPE250" "")
(command "Erase" obj "")
(setvar "osmode" oldsnap)
)

(defun c:P100 ()
(pipeoffset 0.06)
)
(defun c:P150 ()
(pipeoffset 0.08)
)
(defun c:P225 ()
(pipeoffset 0.152)
)
(defun c:P300 ()
(pipeoffset 0.19)
)
(defun c:P375 ()
(pipeoffset 0.228)
)
(defun c:P450 ()
(pipeoffset 0.265)
)
(defun c:P525 ()
(pipeoffset 0.308)
)
(defun c:P600 ()
(pipeoffset 0.35)
)
(defun c:P675 ()
(pipeoffset 0.39)
)
(defun c:P750 ()
(pipeoffset 0.432)
)
(defun c:P825 ()
(pipeoffset 0.473)
)
(defun c:P900 ()
(pipeoffset 0.515)
)
(defun c:P975 ()
(pipeoffset 0.528)
)
(defun c:P1050 ()
(pipeoffset 0.597)
)
(defun c:P1125 ()
(pipeoffset 0.6)
)
(defun c:P1200 ()
(pipeoffset 0.68)
)
(princ)

页: [1]

乐筑天下's Archiver

将单线转换为双线