xtyux 发表于 2022-7-5 16:45:08

Lisp修剪简单图案填充

很好的一天!
 
我在做一个例行公事
 
1.输入矩形大小>>完成
2.插入自定义图案填充>>完成
3.修剪边界,使填充图案成为四边形Polyn(如图所示)>>需要帮助
4.PEDIT>>我能应付
5.挤出>>我能处理
 
我需要第三位的帮助。矩形不同,图案填充也不同。但基本上,它通常是在附加的图像。
 
https://z-1-scontent.fmnl3-2.fna.fbcdn.net/v/t1.0-9/16174669_10210380662925759_4194327343271655470_n.jpg?_nc_eui2=v1%3AAeHyTOea79B2MdmkSJP941DcrAKsudMvnQtwl8bg6o-qoGuQIsiaHKr_2C2IO9Dw77mQ_dW2x6b-6tPTgb2fubzqgoZPl5sYsBtnyknMiWgY8hSX8y2lgfxMwysIQIjELRo&oh=d83f91696cbe25241ad192c89937a898&oe=59187414
 
有可能吗?非常感谢。

marko_ribar 发表于 2022-7-5 17:06:47

首先分解图案填充和关联边界。。。
然后
这里是否解释了这些程序:
http://forums.augi.com/showthread.php?168170-连接处修剪需要Lisp&p=#2
 
创建复杂区域后,分解它并使用JOIN命令将轮廓转换为LWDOLYLINE,或根据需要进行PEDIT(多->连接)选项。。。
 
HTH。,M、 R。

xtyux 发表于 2022-7-5 17:20:39

谢谢marko,但我只有autocad 2007。我在看那些应用程序,total boundary pro似乎可以即时处理这些应用程序,但根据他们的网站,autocad 2007不支持这些应用程序。我会详细调查的。

BIGAL 发表于 2022-7-5 17:29:19

我做了一些类似的事情,诚实地说,从来没有真正完成它,但它在任何形状内绘制平行线,而不是图案填充,它没有连接两端,因为它使用extrim来剪裁比形状大的线。
 

; chevron island creater
; this use the extrim command to trim shape
; By Alan H Jan 2012
(defun C:Chevron ( / obj pt1 pt2 pt3 pt4 newpt1 newpt2 )

(setq obj (car (entsel "\nPick pline or circle")))
; should do a object test here
(setq whatis (cdr (assoc 0 (entget obj))))
(if (= whatis "LWPOLYLINE")
(princ)
(progn
(princ "\You have picked something other than a polyline ")
(princ "\Remake into a pline and do again ")
(setq dummy (getstring "\press any key"))
(exit)
) ; progn
) ; if
(alert "draw a line at angle \nmake sure it is full over shape")
(setq pt1 (Getpoint "\nPick Line start point"))
(setq pt2 (Getpoint pt1 "\nPick end point"))
(command "line" pt1 pt2 "") ;

(setq gap1 (getreal "\nenter spacing 1"))
(setq gap2 (getreal "\nenter spacing 2"))

(setq pt3 (getpoint "\nPick 1st cross point"))
(setq pt4 (getpoint pt3 "\nPick 2nd cross point"))
(setq dist (distance pt3 pt4))
(setq x (fix (/ dist (+ gap1 gap2))))

(setq newpt1 (strcat (rtos gap1 2 2) ",0.0"))
(setq newpt2 (strcat (rtos gap2 2 2) ",0.0"))

(repeat x
(command "copy" "L" "" "0,0" newpt1)
(command "copy" "L" "" "0,0" newpt2)
)

(load "Extrim")
(etrim obj pt1)

) ; end defun


(princ)

xtyux 发表于 2022-7-5 17:33:26

下面的代码来自李·麦克。我在另一个网站上看到的。我把它贴在这里可以吗?归功于李·麦克。
 
(defun c:brkAll (/ *error* doc spc ss Objlst Obj iLst Altlst lst)
(vl-load-com)

(defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
         (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
   (princ
       (strcat "\n** Error: " msg " **")))
   (princ))

(setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

(setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))

(vla-StartUndoMark doc)
(or *brk$dis* (setq *brk$dis* 5.))
(if (setq ss (ssget '((0 . "*LINE,ARC"))))
   (progn
   (or (not
         (setq tmp
             (getdist
               (strcat "\nSpecify Break Distance <" (rtos *brk$dis* 2 2) "> : "))))
         (setq *brk$dis* tmp))
   (setq Objlst
       (mapcar 'vlax-ename->vla-object
         (vl-remove-if 'listp
         (mapcar 'cadr (ssnamex ss)))))
   (while (setq Obj (car Objlst))
       (foreach iObj (setq Objlst (cdr Objlst))
         (setq iLst
         (cons
             (cons Obj
               (vlax-list->3D-point
               (vlax-invoke Obj
                   'IntersectWith iObj acExtendNone))) iLst))))
   (mapcar 'setvar vl '(0 0))
   (foreach Int (vl-remove-if-not
                  (function
                      (lambda (x)
                        (vl-consp (cdr x)))) iLst)
       (setq Obj (car Int))
       (foreach Pt (cdr Int)
         (and Altlst (setq lst Altlst))
         (if (not (setq bDis (vlax-curve-getDistatPoint Obj Pt)))
         (while (and (not bDis) lst)
             (setq bDis (vlax-curve-getDistatPoint (setq Obj (car lst)) Pt)
                   lst (cdr lst))))
         (if bDis
         (progn
             (or (setq bPt1 (vlax-curve-getPointatDist Obj
                              (+ bDis (/ *brk$dis* 2.))))
               (setq bPt1 (vlax-curve-getEndPoint Obj)))
             (or (setq bPt2 (vlax-curve-getPointatDist Obj
                              (- bDis (/ *brk$dis* 2.))))
               (setq bPt2 (vlax-curve-getStartPoint Obj)))
             (command "_.Break"
               (list (vlax-vla-object->ename Obj) pt) "_F" bPt1 bPt2)
             (setq AltLst (cons (vlax-ename->vla-object (entlast)) AltLst)))))))
   (princ "\n** Nothing Selected **"))
(vla-EndUndoMark doc)
(mapcar 'setvar vl ov)
(princ))
            

(defun vlax-list->3D-point (lst)
(if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
         (vlax-list->3D-point (cdddr lst)))))
 
我所做的是修改了他的代码以打断所有相交的线。
我现在的问题是如何选择具有特定层且长度不超过1英寸或1个单位的所有行。我对autolisp有点陌生。我只在网上查看代码并修改试错,但我不知道如何按层和长度筛选行。
 
(ssget“_X”'((0。“LINE”))
或者这也起作用了
(ssget“_X”'((8。“layername”))但我需要指定关于特定长度的条件。
 
如果有人能帮忙,谢谢

xtyux 发表于 2022-7-5 17:45:52

谢谢,我会调查的。
页: [1]
查看完整版本: Lisp修剪简单图案填充