社区 › Auto Lisp › 在端点处自动插入块

jake77777 发表于 2022-7-6 07:37:44

在端点处自动插入块

我第一次看到这个Lisp程序的地方就很喜欢。它允许您在选定对象的所有端点插入指定块。这将是可怕的用于插入基脚后尺寸。。我们发现，对于我们的美国来说，在规定的距离上划线，然后快速标注尺寸效果很好。我们只需要在标注尺寸之前添加这个lisp，我们就可以自动放置我们的基脚了！我唯一搞不清楚的问题是如何以1:1的比例导入块，而不是以dim-scale/txt高度为基础。谢谢托马斯让我发布这个！
 
 

;;; ENDTICK.LSP
;;;
;;; Copyright 2006 Thomas Gail Haws
;;; This program is free software under the terms of the
;;; GNU (GNU--acronym for Gnu's Not Unix--sounds like canoe)
;;; General Public License as published by the Free Software Foundation,
;;; version 2 of the License.
;;;
;;; You can redistribute this software for any fee or no fee and/or
;;; modify it in any way, but it and ANY MODIFICATIONS OR DERIVATIONS
;;; continue to be governed by the license, which protects the perpetual
;;; availability of the software for free distribution and modification.
;;;
;;; You CAN'T put this code into any proprietary package.Read the license.
;;;
;;; If you improve this software, please make a revision submittal to the
;;; copyright owner at www.hawsedc.com.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.See the
;;; GNU General Public License on the World Wide Web for more details.
;;;
;;; DESCRIPTION
;;;
;;; ENDTICK inserts and aligns the ENDTICK block at the endpoint of every arc or line
;;; in a selection set.It removes duplicate ticks.
;;;
;;; ENDTICK is useful for surveying and civil engineering plans to demarcate points of
;;; curvature, tangency, et cetera.
;;;
;;; You can make your own ENDTICK block if you prefer some custom shape or size tick.
;;; The default ENDTICK block is a one unit long vertical line with its insertion point
;;; at its midpoint.ENDTICK scales the ticks to the dimension text height
;;; (dimscale * dimtext), so the default ENDTICK block will look as big as the current
;;; dimension text height.
;;;
;;; Revisions
;;; 20060914TGH   Version 1.0PR released.3 hrs.Works only with world UCS and View

(defun c:ENDTICK () (ENDTICK))

(defun
ENDTICK
      ;;No global variables.All the variables should be listed here as local.
      (/      CENPOINT    DS      DT      ENDANG
       ENDPOINT    ENTLIST      ENTNAME    ENTTYPE      I
       MINTICKSEPARATION      RADIUS    SS1      STARTANG
       STARTPOINT    TICKLIST    TS
      )
;;Set initial variables
(setq
   ds (getvar "dimscale")
   dt (getvar "dimtxt")
   ts (* ds dt)
   ;;If endpoints are closer together than the distance given below
   ;; and also aligned angularly closer than the angular difference below,
   ;; ENDTICK only plots the first one of them it finds.
   mintickseparation
    (* ts 0.01)
   ;;In radians.Setting to some big number like 10 (larger than 2 pi) will remove coincident ticks even with different rotations.
   mintickangulardif
    0.01
)
;;Get selection set from user.Limit to lines and arcs.
(setq
   ss1    (ssget '((0 . "LINE,ARC")))
   i    -1
)
;;Get endpoints and orientations from selection set
(while (setq entname (ssname ss1 (setq i (1+ i))))
   (setq
   entlist
      (entget entname)
   enttype
      (cdr (assoc 0 entlist))
   )
   (cond
   ((= enttype "LINE")
      (setq
    startpoint
   (cdr (assoc 10 entlist))
    endpoint
   (cdr (assoc 11 entlist))
    ticklist
   (ENDTICK-addtolist
       (list startpoint (angle startpoint endpoint))
       ticklist
       mintickseparation
       mintickangulardif
   )
    ticklist
   (ENDTICK-addtolist
       (list
         endpoint
         (angle endpoint startpoint)
       )
       ticklist
       mintickseparation
       mintickangulardif
   )
      )
   )

   ((= enttype "ARC")
      (setq
    cenpoint
   (cdr (assoc 10 entlist))
    radius
   (cdr (assoc 40 entlist))
    startang
   (cdr (assoc 50 entlist))
    endang
   (cdr (assoc 51 entlist))
    startpoint
   (polar cenpoint startang radius)
    endpoint
   (polar cenpoint endang radius)
    ticklist
   (ENDTICK-addtolist
       (list startpoint (+ startang (/ pi 2)))
       ticklist
       mintickseparation
       mintickangulardif
   )
    ticklist
   (ENDTICK-addtolist
       (list endpoint (+ endang (/ pi 2)))
       ticklist
       mintickseparation
       mintickangulardif
   )
      )
   )
   )
)
(setq auold (getvar "aunits"))
(setvar "aunits" 3)
(foreach
    tick ticklist
   (command "._insert" "endtick" (car tick) ts "" (cadr tick))
)
(setvar "aunits" auold)
)

(defun
ENDTICK-addtolist
            (tick          ticklist          mintickseparation
             mintickangulardif            /
             dupfound          templist          tickcheck
            )
;;Look for duplicates in list
(setq templist ticklist)
(while (setq tickcheck (car templist))
   (if    (and
   (< (distance (car tick) (car tickcheck)) mintickseparation)
   (< (abs (- (cadr tick) (cadr tickcheck))) mintickangulardif)
   )
   (setq
   dupfound
    T
   templist
    nil
   )
   (setq templist (cdr templist))
   )
)
(if (not dupfound)
   (cons tick ticklist)
   ticklist
)
)

jake77777 发表于 2022-7-6 07:42:10

用于导入的块
endtick。图纸

Lee Mac 发表于 2022-7-6 07:49:06

代码格式：
 
http://www.cadtutor.net/forum/showthread.php?9184-代码发布指南

jake77777 发表于 2022-7-6 07:52:01

谢谢需要最后提醒。。。
 
;;; ENDTICK.LSP
;;;
;;; Copyright 2006 Thomas Gail Haws
;;; This program is free software under the terms of the
;;; GNU (GNU--acronym for Gnu's Not Unix--sounds like canoe)
;;; General Public License as published by the Free Software Foundation,
;;; version 2 of the License.
;;;
;;; You can redistribute this software for any fee or no fee and/or
;;; modify it in any way, but it and ANY MODIFICATIONS OR DERIVATIONS
;;; continue to be governed by the license, which protects the perpetual
;;; availability of the software for free distribution and modification.
;;;
;;; You CAN'T put this code into any proprietary package.Read the license.
;;;
;;; If you improve this software, please make a revision submittal to the
;;; copyright owner at www.hawsedc.com.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.See the
;;; GNU General Public License on the World Wide Web for more details.
;;;
;;; DESCRIPTION
;;;
;;; ENDTICK inserts and aligns the ENDTICK block at the endpoint of every arc or line
;;; in a selection set.It removes duplicate ticks.
;;;
;;; ENDTICK is useful for surveying and civil engineering plans to demarcate points of
;;; curvature, tangency, et cetera.
;;;
;;; You can make your own ENDTICK block if you prefer some custom shape or size tick.
;;; The default ENDTICK block is a one unit long vertical line with its insertion point
;;; at its midpoint.ENDTICK scales the ticks to the dimension text height
;;; (dimscale * dimtext), so the default ENDTICK block will look as big as the current
;;; dimension text height.
;;;
;;; Revisions
;;; 20060914TGH   Version 1.0PR released.3 hrs.Works only with world UCS and View

(defun c:ENDTICK () (ENDTICK))

(defun
ENDTICK
      ;;No global variables.All the variables should be listed here as local.
      (/      CENPOINT    DS      DT      ENDANG
       ENDPOINT    ENTLIST      ENTNAME    ENTTYPE      I
       MINTICKSEPARATION      RADIUS    SS1      STARTANG
       STARTPOINT    TICKLIST    TS
      )
;;Set initial variables
(setq
   ds (getvar "dimscale")
   dt (getvar "dimtxt")
   ts (* ds dt)
   ;;If endpoints are closer together than the distance given below
   ;; and also aligned angularly closer than the angular difference below,
   ;; ENDTICK only plots the first one of them it finds.
   mintickseparation
    (* ts 0.01)
   ;;In radians.Setting to some big number like 10 (larger than 2 pi) will remove coincident ticks even with different rotations.
   mintickangulardif
    0.01
)
;;Get selection set from user.Limit to lines and arcs.
(setq
   ss1    (ssget '((0 . "LINE,ARC")))
   i    -1
)
;;Get endpoints and orientations from selection set
(while (setq entname (ssname ss1 (setq i (1+ i))))
   (setq
   entlist
      (entget entname)
   enttype
      (cdr (assoc 0 entlist))
   )
   (cond
   ((= enttype "LINE")
      (setq
    startpoint
   (cdr (assoc 10 entlist))
    endpoint
   (cdr (assoc 11 entlist))
    ticklist
   (ENDTICK-addtolist
       (list startpoint (angle startpoint endpoint))
       ticklist
       mintickseparation
       mintickangulardif
   )
    ticklist
   (ENDTICK-addtolist
       (list
         endpoint
         (angle endpoint startpoint)
       )
       ticklist
       mintickseparation
       mintickangulardif
   )
      )
   )

   ((= enttype "ARC")
      (setq
    cenpoint
   (cdr (assoc 10 entlist))
    radius
   (cdr (assoc 40 entlist))
    startang
   (cdr (assoc 50 entlist))
    endang
   (cdr (assoc 51 entlist))
    startpoint
   (polar cenpoint startang radius)
    endpoint
   (polar cenpoint endang radius)
    ticklist
   (ENDTICK-addtolist
       (list startpoint (+ startang (/ pi 2)))
       ticklist
       mintickseparation
       mintickangulardif
   )
    ticklist
   (ENDTICK-addtolist
       (list endpoint (+ endang (/ pi 2)))
       ticklist
       mintickseparation
       mintickangulardif
   )
      )
   )
   )
)
(setq auold (getvar "aunits"))
(setvar "aunits" 3)
(foreach
    tick ticklist
   (command "._insert" "endtick" (car tick) ts "" (cadr tick))
)
(setvar "aunits" auold)
)

(defun
ENDTICK-addtolist
            (tick          ticklist          mintickseparation
             mintickangulardif            /
             dupfound          templist          tickcheck
            )
;;Look for duplicates in list
(setq templist ticklist)
(while (setq tickcheck (car templist))
   (if    (and
   (< (distance (car tick) (car tickcheck)) mintickseparation)
   (< (abs (- (cadr tick) (cadr tickcheck))) mintickangulardif)
   )
   (setq
   dupfound
    T
   templist
    nil
   )
   (setq templist (cdr templist))
   )
)
(if (not dupfound)
   (cons tick ticklist)
   ticklist
)
)

Lee Mac 发表于 2022-7-6 07:57:03

很快就被砍掉了。。。
 

;;---------------------=={ EndBlock }==-----------------------;;
;;                                                            ;;
;;Inserts a Block at the end points of selected objects   ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;

(defun c:EndBlock ( / *error* _StartUndo _EndUndo _Insert _AngleAtParam doc spc block ss )
(vl-load-com)
;; © Lee Mac 2010

(setq block "endtick.dwg") ;; << Block Name

(defun *error* ( msg )
   (and doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
)

(defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
)

(defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
   (vla-EndUndoMark doc)
   )
)

(defun _Insert ( space block point scale rotation )
   (if
   (not
       (vl-catch-all-error-p
         (setq result
         (vl-catch-all-apply 'vla-insertblock
             (list space (vlax-3D-point point) block scale scale scale rotation)
         )
         )
       )
   )
   result
   )
)

(defun _AngleatParam ( entity param )
   (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv entity param))
)      

(LM:ActiveSpace 'doc 'spc)

(cond
   ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))

   (princ "\n** Current Layer Locked **")
   )
   ( (not
       (or (tblsearch "BLOCK" block)
         (setq block
         (findfile
             (strcat block
               (if (eq "" (vl-filename-extension block)) ".dwg" "")
             )
         )
         )
       )
   )

   (princ "\n** Block not Found **")
   )
   ( (not (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,SPLINE,LINE,LWPOLYLINE,")))))

   (princ "\n*Cancel*")
   )
   (t

   (_StartUndo doc)
   
   (
       (lambda ( i / e )
         (while (setq e (ssname ss (setq i (1+ i))))
         (mapcar
             (function
               (lambda ( point rotation )
               (_Insert spc block point 1.0 rotation)
               )
             )
             (if (vlax-curve-isClosed e)
               (list (vlax-curve-getStartPoint e))
               (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
             )
             (mapcar
               (function
               (lambda ( param ) (_AngleAtParam e param))
               )
               (if (vlax-curve-isClosed e)
               (list (+ (vlax-curve-getStartParam e) 1e-4))
               (list (+ (vlax-curve-getStartParam e) 1e-4) (- (vlax-curve-getEndParam e) 1e-4))
               )
             )
         )
         )
       )
       -1
   )

   (_EndUndo doc)
   )
)

(princ)
)            

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;Arguments:                                                ;;
;;*doc - quoted symbol other than *doc                      ;;
;;*spc - quoted symbol other than *spc                      ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
;; © Lee Mac 2010
(set *spc
   (if
   (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
         (set *doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
         )
         )
       )
       (eq :vlax-true (vla-get-MSpace (eval *doc)))
   )
   (vla-get-ModelSpace (eval *doc))
   (vla-get-PaperSpace (eval *doc))
   )
)
)

 
在第二个代码中，添加以下内容：
 

;;---------------------=={ EndBlock }==-----------------------;;
;;                                                            ;;
;;Inserts a Block at the end points of selected objects   ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;

(defun c:EndBlock ( / *error* _StartUndo _EndUndo _Insert _AngleAtParam doc block ss )
(vl-load-com)
;; © Lee Mac 2010

(setq block "endtick.dwg") ;; << Block Name

(defun *error* ( msg )
   (and doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
)

(defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
)

(defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
   (vla-EndUndoMark doc)
   )
)

(defun _Insert ( block point rotation )
   (entmakex
   (list
       (cons 0 "INSERT")
       (cons 2block)
       (cons 10 point)
       (cons 50 rotation)
   )
   )
)

(defun _AngleatParam ( entity param )
   (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv entity param))
)      

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

(cond
   ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))

   (princ "\n** Current Layer Locked **")
   )
   ( (not
       (or
         (and (tblsearch "BLOCK" (vl-filename-base block))
         (setq block (vl-filename-base block))
         )
         (and
         (setq block
             (findfile
               (strcat block
               (if (eq "" (vl-filename-extension block)) ".dwg" "")
               )
             )
         )
         (
             (lambda ( / ocm )
               (setq ocm (getvar 'CMDECHO)) (setvar 'CMDECHO 0)
               (command "_.-insert" block) (command)
               (setvar 'CMDECHO ocm)
               
               (tblsearch "BLOCK" (setq block (vl-filename-base block)))
             )
         )
         )
       )
   )

   (princ "\n** Block not Found **")
   )
   ( (not (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,SPLINE,LINE,LWPOLYLINE,")))))

   (princ "\n*Cancel*")
   )
   (t

   (_StartUndo doc)
   
   (
       (lambda ( i / e )
         (while (setq e (ssname ss (setq i (1+ i))))
         (mapcar
             (function
               (lambda ( point rotation ) (_Insert block point rotation))
             )
             (if (vlax-curve-isClosed e)
               (list (vlax-curve-getStartPoint e))
               (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
             )
             (mapcar
               (function
               (lambda ( param ) (_AngleAtParam e param))
               )
               (if (vlax-curve-isClosed e)
               (list (+ (vlax-curve-getStartParam e) 1e-4))
               (list (+ (vlax-curve-getStartParam e) 1e-4) (- (vlax-curve-getEndParam e) 1e-4))
               )
             )
         )
         )
       )
       -1
   )

   (_EndUndo doc)
   )
)

(princ)
)            

Lee Mac 发表于 2022-7-6 08:00:34

李，谢谢你的辅导！
史蒂夫

jake77777 发表于 2022-7-6 08:06:23

不客气，史蒂夫，随时欢迎。

Lee Mac 发表于 2022-7-6 08:09:52

我受够了这个Lisp程序！只是好奇。正如代码所示。。它只将块导入端点，而不将块添加到PLINE内直线的端点。。是否可以将块导入到选定多条线组内的点？。。甚至更多，仅仅是这些点，而不包括端点？我的第一个业余举动是在片段中加入普林
(_Insert spc block point 1.0 rotation)
这并没有做到，我在下面使用节点插入时遇到了类似的代码，但想到所有的捕捉设置，我不知道这样的事情是怎么可能的。。有什么建议吗？
 
 
很抱歉，我找不到作者对此给予赞扬。。
(defun _Insert ( block point rotation )
   (entmakex
   (list
       (cons 0 "INSERT")
       (cons 2block)
       (cons 10 point)
       (cons 50 rotation)
      (cons 41 1.0) ;; X Scale
       (cons 42 1.0) ;; Y Scale
       (cons 43 1.0) ;; Z Scale
   )
   )
)
这是李的优秀作品，我正在使用从第1页的帖子。。。
( (not (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,SPLINE,PLINE,LINE,LWPOLYLINE,")))))

stevesfr 发表于 2022-7-6 08:15:59

此lisp不适用于区域
你能修改一下以处理地区问题吗

Lee Mac 发表于 2022-7-6 08:19:25

查看完整版本: 在端点处自动插入块