[编程交流] 任何绘制线条的函数

(defun DB_LINE (WallWidth / Point1 Point2 StartPt Start1 Start2 Line1 Line2 Line3 Line4 Int2 WallLayer WallLine)
;; Set the correct layer
(setq WallLayer "0")
(setq WallLine "BYLAYER")
;; Get first point
(setq Point1 (getpoint "\n Define first point: "))
;; Define first point as startpoint
(setq        StartPt Point1)
;; Get next point
(setq        Point2 (getpoint Point1 "\n Define next point: "))
;; start to create the wall
(setq        Line1 (vlax-ename->vla-object (STDLIB_CREATE_LINE Point1 Point2 WallLayer WallLine 256)))
;; Defin the first line as the strting line
(setq        Start1 Line1)
;; Create second line
(setq        Line2 (car (vlax-invoke Line1 'offset WallWidth)))
;; Define the second line as the second start line
(setq        Start2 Line2)
;; Reset the first point to the second point
(setq        Point1 Point2)
;; While we are creating lines
(while 
        ;; Meet these criteria
        (progn
                ;; Watch to close
                (initget "Close")
                ;; get next point
                (setq Point2 (getpoint Point1 "\n Define next point: "))
                ;; Check to see if it is a point list
                (= (type Point2) 'LIST)
        )
        ;; Create next section of wall
        (setq Line3 (vlax-ename->vla-object (STDLIB_CREATE_LINE Point1 Point2 WallLayer WallLine 256)))
        (setq Line4 (car (vlax-invoke Line3 'offset WallWidth)))
        ;; Get the intersection of the first section and the second section
        (setq Int2 (vlax-invoke Line2 'intersectwith Line4 acExtendBoth))
        ;; Chang the end points to meet
        (vlax-put Line2 'endpoint Int2)
        (vlax-put Line4 'startpoint Int2)
        ;; Reset the lines
        (setq Line1 Line3)
        (setq Line2 Line4)
        ;; Reset the point
        (setq Point1 Point2)
)
;; If the user want to close the line
(if (= Point2 "Close")
        (progn
                ;; Create last section of wall
                (setq Line3 (vlax-ename->vla-object (STDLIB_CREATE_LINE Point1 StartPt WallLayer WallLine 256)))
                (setq Line4 (car (vlax-invoke Line3 'offset WallWidth)))
                ;; Get the intersection of the first section and the second section
                (setq Int2 (vlax-invoke Line2 'intersectwith Line4 acExtendBoth))
                ;; Reset the lines
                (vlax-put Line2 'endpoint Int2)
                (vlax-put Line4 'startpoint Int2)                        
                ;; Now close it ....
                ;; Get the intersection of the last section and the first section
                (setq Int2 (vlax-invoke Start2 'intersectwith Line4 acExtendBoth))
                ;; Chang the end points to meet
                (vlax-put Line4 'endpoint Int2)
                (vlax-put Start2 'startpoint Int2)
        )
)
)
;;; ------------------------------------------------------------------------
;;;    STDLIB_CREATE_LINE.LSP
;;;
;;;    Copyright © December, 2008
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    STDLIB_CREATE_LINE
;;;
;;;                 Description:
;;;                        Called from a menu pulldown or rightclick menu
;;;                * (STDLIB_CREATE_LINE <STARTPOINT> <ENDPOINT> <LAYER> <LINETYPE> <COLOR> )
;;;                <STARTPOINT>        =        LIST                =        List of 2D / 3D points
;;;                <ENDPOINT>                =        LIST                =        List of 2D / 3D points
;;;                <LAYER>                                =        STRING        =        Valid layer name
;;;                <LINETYPE>                =        STRING        =        Valid linetype (loaded)
;;;                <COLOR>                                = REAL                = Valid color number
;;;
;;;                        Returns:
;;;                                Ename of created line
;;;
;;; ------------------------------------------------------------------------
;;; MAIN FUNCTION ;;;;;;;;;;;;;;;;;;;;;;;;;
(defun STDLIB_CREATE_LINE (StartPoint EndPoint Layer Linetype Color / LineList)
(setq LineList
        (list
                (cons 0 "LINE")
                (cons 100 "AcDbEntity")
                (cons 100 "AcDbLine")
                (cons 6 Linetype)
                (cons 8 Layer)
                (cons 10 StartPoint)
                (cons 11 EndPoint)
                (cons 39 0.0)
                (cons 62 Color)
                (cons 210 (list 0.0 0.0 1.0))
        )
)
(entmakex LineList)
)
(princ)

(defun C:DB ()
 (or WW (setq WW 4.0))
 (setq WW$ (rtos WW 2 1))
 (setq WW (cond ((getreaL (strcat "\nSpecify wall width: <"WW$">: ")))(T WW)))
 (DB_LINE WW)
 (princ))
(defun DB_LINE (WallWidth / Point1 Point2 StartPt Start1 Start2 Line1 Line2 Line3 Line4 Int2 WallLayer WallLine)
;; Set the correct layer
(setq WallLayer "0")
(setq WallLine "BYLAYER")
;; Get first point
(setq Point1 (getpoint "\n Define first point: "))
;; Define first point as startpoint
(setq        StartPt Point1)
;; Get next point
(setq        Point2 (getpoint Point1 "\n Define next point: "))
;; start to create the wall
(setq        Line1 (vlax-ename->vla-object (STDLIB_CREATE_LINE Point1 Point2 WallLayer WallLine 256)))
;; Defin the first line as the strting line
(setq        Start1 Line1)
;; Create second line
(setq        Line2 (car (vlax-invoke Line1 'offset WallWidth)))
;; Define the second line as the second start line
(setq        Start2 Line2)
;; Reset the first point to the second point
(setq        Point1 Point2)
;; While we are creating lines
(while 
        ;; Meet these criteria
        (progn
                ;; Watch to close
                (initget "Close")
                ;; get next point
                (setq Point2 (getpoint Point1 "\n Define next point: "))
                ;; Check to see if it is a point list
                (= (type Point2) 'LIST)
        )
        ;; Create next section of wall
        (setq Line3 (vlax-ename->vla-object (STDLIB_CREATE_LINE Point1 Point2 WallLayer WallLine 256)))
        (setq Line4 (car (vlax-invoke Line3 'offset WallWidth)))
        ;; Get the intersection of the first section and the second section
        (setq Int2 (vlax-invoke Line2 'intersectwith Line4 acExtendBoth))
        ;; Chang the end points to meet
        (vlax-put Line2 'endpoint Int2)
        (vlax-put Line4 'startpoint Int2)
        ;; Reset the lines
        (setq Line1 Line3)
        (setq Line2 Line4)
        ;; Reset the point
        (setq Point1 Point2)
)
;; If the user want to close the line
(if (= Point2 "Close")
        (progn
                ;; Create last section of wall
                (setq Line3 (vlax-ename->vla-object (STDLIB_CREATE_LINE Point1 StartPt WallLayer WallLine 256)))
                (setq Line4 (car (vlax-invoke Line3 'offset WallWidth)))
                ;; Get the intersection of the first section and the second section
                (setq Int2 (vlax-invoke Line2 'intersectwith Line4 acExtendBoth))
                ;; Reset the lines
                (vlax-put Line2 'endpoint Int2)
                (vlax-put Line4 'startpoint Int2)                        
                ;; Now close it ....
                ;; Get the intersection of the last section and the first section
                (setq Int2 (vlax-invoke Start2 'intersectwith Line4 acExtendBoth))
                ;; Chang the end points to meet
                (vlax-put Line4 'endpoint Int2)
                (vlax-put Start2 'startpoint Int2)
        )
)
)
;;; ------------------------------------------------------------------------
;;;    STDLIB_CREATE_LINE.LSP
;;;
;;;    Copyright © December, 2008
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    STDLIB_CREATE_LINE
;;;
;;;                 Description:
;;;                        Called from a menu pulldown or rightclick menu
;;;                * (STDLIB_CREATE_LINE <STARTPOINT> <ENDPOINT> <LAYER> <LINETYPE> <COLOR> )
;;;                <STARTPOINT>        =        LIST                =        List of 2D / 3D points
;;;                <ENDPOINT>                =        LIST                =        List of 2D / 3D points
;;;                <LAYER>                                =        STRING        =        Valid layer name
;;;                <LINETYPE>                =        STRING        =        Valid linetype (loaded)
;;;                <COLOR>                                = REAL                = Valid color number
;;;
;;;                        Returns:
;;;                                Ename of created line
;;;
;;; ------------------------------------------------------------------------
;;; MAIN FUNCTION ;;;;;;;;;;;;;;;;;;;;;;;;;
(defun STDLIB_CREATE_LINE (StartPoint EndPoint Layer Linetype Color / LineList)
(setq LineList
        (list
                (cons 0 "LINE")
                (cons 100 "AcDbEntity")
                (cons 100 "AcDbLine")
                (cons 6 Linetype)
                (cons 8 Layer)
                (cons 10 StartPoint)
                (cons 11 EndPoint)
                (cons 39 0.0)
                (cons 62 Color)
                (cons 210 (list 0.0 0.0 1.0))
        )
)
(entmakex LineList)
)
(princ) 

(STDLIB_CREATE_LINE Point1 Point2 WallLayer WallLine 256)

(defun C:DB ()
 (or WW (setq WW 4.0))
 (setq WW$ (rtos WW 2 1))
 (setq WW (cond ((getreaL (strcat "\nSpecify wall width: <"WW$">: ")))(T WW)))
 (DB_LINE [color="Red"]WW[/color])
 (princ))
(defun DB_LINE ([color="red"]WallWidth[/color] / Point1 Point2 StartPt Start1 Start2 Line1 Line2 Line3 Line4 Int2 WallLayer WallLine) 

(DB_LINE WW)

(defun C:Dline ()
  (setq pl (getpoint"\nSpecify first point:"))
 (DB_LINE)
 (princ))