Lisp用于同一个中的双偏移
大家好。。。我再次需要帮助。
我希望lisp在同一侧但不同距离上进行双偏移。一条线距为1.70mm，另一条线距源线为1.75mm。
提前谢谢。 这个怎么样？您必须选择要偏移的线，然后选择要偏移的边。
^C^C^C(Setq OSL (Entsel "Select line to offset: "));\offset;1.70;!OSL;\;offset;1.75;!OSL;\;
不要忘记，您也可以使用多行来实现这一点。根据使用情况，它可能会有所帮助。 你好，mwade93。。
谢谢你的宏字符串。。。。这根绳子很好用。
该字符串需要为每个操作单击工具按钮。
但我希望这个字符串一直重复到用户端。 你想让它一次又一次地重复吗？如果是这样，您只需添加一个*字符。用户将不得不使用退出键取消它，但它将重复，直到这一点。
*^C^C^C(Setq OSL (Entsel "Select line to offset: "));\offset;1.70;!OSL;\;offset;1.75;!OSL;\; 单向。
(defun c:test (/ s p)
(while (and (setq s (car (entsel "\nSelect line to offset :")))
(= (cdr (assoc 0 (entget s))) "LINE")
(setq p (getpoint "\nSpecify offset side :"))
)
(foreach x '(1.7 1.75)
(command "_.offset" x (ssadd s) "_non" p "")
)
)
(princ)
) 虽然这是我一直以来的最爱，但我可以提出如下建议：
(defun C:test ( / *error* acDoc sUndo Svars R n oLst o )
(defun *error* (m)
(and sUndo (vla-EndUndoMark acDoc)) (redraw)
(and Svars (mapcar 'setvar (mapcar 'car Svars) (mapcar 'cdr Svars)))
(and m (print m))
(princ)
); defun *error*
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-EndUndoMark acDoc) (setq sUndo (not (vla-StartUndoMark acDoc)))
(setq Svars (mapcar (function (lambda (x) (cons x (getvar x)))) '("CLIPROMPTLINES" "PICKBOX" "CMDECHO")))
(and Svars (mapcar 'setvar (mapcar 'car Svars) '(0 12 0)))
(setvar 'errno 0) (redraw)
(while (/= 52 (getvar 'errno))
(initget 128 "Distance")
(setq R (entsel (strcat "\nSpecify side to offset or istance " (if oLst (vl-princ-to-string (reverse oLst)) "") " <exit>: ")))
(cond
((= 7 (getvar 'errno)) (princ "\nNothing selected.") (setvar 'errno 0))
( (= 'STR (type R))
(while (setq n (getreal (strcat "\nSpecify offset value from the curve " (if oLst (vl-princ-to-string (reverse oLst)) "") " <enter>: ")))
(princ (strcat "\nOffset values: " (vl-princ-to-string (reverse (setq oLst (cons n oLst))))))
)
(setq oLst (reverse oLst))
)
((and (vl-consp R) (eq 'ENAME (type (car R))) (setq o (vlax-ename->vla-object (car R))) (not (vlax-method-applicable-p o 'Offset)))
(princ "\nThis object can not be offseted.") (setq o nil)
)
((and o (eq (vla-get-Lock (vla-item (vla-get-Layers acDoc) (vla-get-Layer o))) :vlax-true))
(princ "\nThis object is on a locked layer.") (setq o nil)
)
((and o (not oLst))
(grdraw (cadr R) (vlax-curve-getClosestPointTo o (cadr R)) 1 7)
(while (setq n (getreal (strcat "\nSpecify offset value from the curve " (if oLst (vl-princ-to-string (reverse oLst)) "") " <enter>: ")))
(princ (strcat "\nOffset values: " (vl-princ-to-string (reverse (setq oLst (cons n oLst))))))
)
(and (vl-consp oLst) (apply 'and (mapcar 'numberp oLst)) (setvar 'errno 52))
)
( (and o (vl-consp oLst) (apply 'and (mapcar 'numberp oLst))) (setvar 'errno 52) )
(T nil)
); cond
); while
(foreach x oLst (command "_.OFFSET" x (car R) "_non" (cadr R) "E") ); (vla-Offset o x)
(and sUndo (vla-EndUndoMark acDoc))
(and Svars (mapcar 'setvar (mapcar 'car Svars) (mapcar 'cdr Svars)))
(redraw) (princ)
);| defun |; (vl-load-com) (princ)
正如您在2014年看到的那样，这是一种通过命令行see for image生成多个偏移的简单方法http://www.cadtutor.net/forum/showthread.php?84919-绘制双多段线/第2页
; multiple pline including width & col function
; single entry is offset only use +ve or -ve numbers for left and right
; two values 3,1 means offset 3 with width 1
; three values 3,2,1 means offset 3 with start width 2 end 1
; by Alan H March 2014
; thanks to Lee-mac for this defun
(defun _csv->lst ( str / pos )
(if (setq pos (vl-string-position 44 str))
(cons (substr str 1 pos) (_csv->lst (substr str (+ pos 2))))
(list str)
)
)
(defun aH:multpl ( / pt1 pt2 pt3 obj1 obj2 dist1 pwidst plcol lst howmany)
(setvar "PLINEWID" 0) ;set PL width to 0
(command "_pline")
(while (= (getvar "cmdactive") 1 ) (command pause)
)
(setq pt1 nil)
(setq obj1 (entlast)) ; grab pline
(setq pt1 (getvar "lastpoint")) ; last pt
(command "circle" pt1 100.0) ; do something smart here like screen scale for circle
(setq obj2(entlast)) ;grab circle
(setq pt2 (vlax-invoke (vlax-ename->vla-object obj1) 'intersectWith (vlax-ename->vla-object obj2) acextendnone)); find int point
(setq ang (angle pt1 pt2)) ;angle of pline now know left right
(command "erase" "last" "") ; remove circle
(while (/= (setq offval (getstring "Enter offset distance -ve for left")) "")
(setq lst (cons (_csv->lst offval) lst))
(setq howmany (length (nth 0 lst))) ;determines single or multi answer
(if (= howmany 1)(setq dist1 (atof (nth 0 (nth 0 lst)))) )
(if (= howmany 2)
(progn
(setq dist1 (atof (nth 0 (nth 0 lst))))
(setq pwidst (atof (nth 1 (nth 0 lst))))
) ; progn
); if
(if (= howmany 3)
(progn
(setq dist1 (atof (nth 0 (nth 0 lst))))
(setq pwidst (atof (nth 1 (nth 0 lst))))
(setq pLcol (atof (nth 2 (nth 0 lst))))
) ; progn
); if
(if (> dist1 0.0)
(setq pt3 (polar pt2 (+ ang (/ pi 2.0)) (abs dist1)))
(setq pt3 (polar pt2 (- ang (/ pi 2.0)) (abs dist1)))
)
(command "offset" (abs dist1) obj1 pt3 "")
(if (>= howmany 2)
(vla-put-ConstantWidth (vlax-ename->vla-object (entlast)) pwidst)
)
(if (= howmany 3)
(vla-put-color (vlax-ename->vla-object (entlast)) plcol) ; note color as a number
)
) ; end while
(command "erase" obj1 "")
) ; end defun
(AH:multpl)
(princ)
您好，Grrr，
遗憾的是，该Lisp在Acad 2017中不起作用。我认为命令移动的执行方式不同。
他们可以再检查一下吗？
非常感谢。
呜呜，对不起，我不知道。
听起来我想重新发明轮子，但对我来说重要的是编码实践/经验。
嗨，Martinel
我建议调用offset命令并检查以下步骤：
(setq e (car (entsel)))
(setq p (getpoint))
(command "_.OFFSET" 500 e "_non" p "E") ; offset the entity "e" on 500 units distance, oriented on the "p" side
这在ACAD2015中有效。 嗨，Grrr
命令：（setq e（car（entsel）））
选择对象：
命令：（setq p（getpoint））
(1443.23 2158.93 0.0)
命令：（命令“_.OFFSET”500 e“\u non”p“e”）
_.抵消
当前设置：Delete source=No Layer=source OFFSETGAPTYPE=0
指定距离或[通过点（T）/删除（D）/图层（L）]：500
选择要移动的对象，或[退出/撤消]：
指定页面上要移动到的点，或[退出/重复/撤消]：
选择要移动的对象或[退出（E）/撤消（U）]：E
*无效的选择*
需要一个点或出口
; 错误：函数中止
页:
[1]
2