自动编号和长度

Lee Mac · 发表于 2022-7-5 19:11:32

You're welcome

I like to use the dynamic approach when placing text, as it gives you a proper preview of what you are about to place. The only drawback to this method is that you don't have any AutoCAD functionality such as OSnap, Ortho, Tracking etc. But I figure most do not use such that regularly to place text.

Lee

asos2000 · 发表于 2022-7-5 19:16:15

Alanjt

see attached image and cad file

plab.dwg

alanjt · 发表于 2022-7-5 19:17:08

Ahh, the woes of vlax-curve-getClosestPointTo and not properly considering it's obvious constraints.

Try it now (also removed the need for the AT:MText subroutine since I was defining the ActiveSpace for each text object.

copy

(defun c:PLab (/ obj) ;; Label each LWPolyline segment with number and distance ;; Alan J. Thompson, 04.21.10 / 04.23.10 (vl-load-com) (if (and (setq obj (car (entsel "\nSelect LWPolyline: ")))          (or (eq "LWPOLYLINE" (cdr (assoc 0 (entget obj))))              (alert "Invalid object!")          )          (setq obj (vlax-ename->vla-object obj))     )   ((lambda (n l s / d)      (while (nth (1+ (setq n (1+ n))) l)        ((lambda (a b / dist)           (setq dist (abs (- (setq d (vlax-curve-getDistAtPoint obj a))                              (vlax-curve-getDistAtPoint obj b)                           )                      )           )           ((lambda (p)              ((lambda (text)                 (vla-put-AttachmentPoint text                  (vla-put-InsertionPoint text p)                 ;; (vla-put-Rotation text (angle a b))                 ((lambda (ang)                    (if (and (> ang (* pi 0.5)) (< ang (* pi 1.5)))                      (vla-put-rotation text (+ pi ang))                      (vla-put-rotation text ang)                    )                  )                   (angle a b)                 )               )                (vla-AddMText s p 0. (strcat (itoa (1+ n)) " - " (rtos dist)))              )            )             (vlax-3d-point (vlax-curve-getPointAtDist obj (+ (/ dist 2.) d)))           )         )          (nth n l)          (nth (1+ n) l)        )      )    )     -1     (AT:ListGroupByNumber (vlax-get obj 'Coordinates) 2)     (if (or (eq acmodelspace                 (vla-get-activespace                   (cond (*AcadDoc*)                         ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))                   )                 )             )             (eq :vlax-true (vla-get-mspace *AcadDoc*))         )       (vla-get-modelspace *AcadDoc*)       (vla-get-paperspace *AcadDoc*)     )   ) ) (princ));;; Group items in list based on specified number;;; L - List to process;;; # - Number of items for grouping;;; Alan J. Thompson, 03.26.10(defun AT:ListGroupByNumber (L # / n g f) (setq n -1) (while (> (1- (length L)) n)   (repeat # (setq g (cons (nth (setq n (1+ n)) L) g)))   (setq f (cons (reverse g) f)         g nil   ) ;_ setq ) ;_ while (reverse f)) ;_ defun

Lee Mac · 发表于 2022-7-5 19:21:33

I think Alan's gone lambda mad

alanjt · 发表于 2022-7-5 19:25:04

ROFL
I did let them get a little out of control. Ever since you did that Boundingbox routine modeled after MP's code, I've been loving and abusing lambda outside of the use of mapcar (or defining as functions like I've been known to do) like a mad man.

I mean, look at this:

copy

    (([color=Red]lambda[/color] (n l s / d)      (while (nth (1+ (setq n (1+ n))) l)        (([color=Red]lambda [/color](a b / dist)           (setq dist (abs (- (setq d (vlax-curve-getDistAtPoint obj a))                              (vlax-curve-getDistAtPoint obj b)                           )                      )           )           (([color=Red]lambda [/color](p)              (([color=Red]lambda [/color](text)                 (vla-put-AttachmentPoint text                  (vla-put-InsertionPoint text p)                 ;; (vla-put-Rotation text (angle a b))                 (([color=Red]lambda [/color](ang)

5 lambda expressions

You know, I'm surprised you haven't commented on my abandonment of end line comments and #Variable assigning.

BTW/off topic: I got a 96 on my Trig test (final Monday) and 2 of those points were taken off because I forgot to denote my units on a problem. If you hadn't answered my questions, I would have been completely lost on that section. Thanks a lot.

Lee Mac · 发表于 2022-7-5 19:27:06

No worries mate, glad it went well for you

gordon_Gjs · 发表于 2022-7-5 19:32:38

Lee Mac the PLen lisp works great for what I am wanting, but would it be possible to have one that would...

Not to do auto numbering.
The total length value gets inserted automatically in the center/midpoint of the polyline.

I would like to go for speed when finding the length of each polyline. If it could be possible I would like to be able to select all polylines and have all the values insert themselvs automatically on each individual polyline.

Thanks agian and hopes its not asking too much.

Lee Mac · 发表于 2022-7-5 19:33:49

Hi Gordon,

Give this a shot, let me know how you get on (using FIELDS),

[code](defun c:PlL ( / *error* spc i ss e Der p obj ) (vl-load-com) ;; Lee Mac ~ 29.04.10 (defun *error* ( msg ) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (setq spc (if (or (eq AcModelSpace (vla-get-ActiveSpace (setq doc (vla-get-ActiveDocument (vlax-get-acad-object) ) ) ) ) (eq :vlax-true (vla-get-MSpace doc)) ) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc) ) ) (if (setq i -1 ss (ssget '((0 . "LINE,*POLYLINE")))) (while (setq e (ssname ss (setq i (1+ i)))) (setq Der (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv e (vlax-curve-getParamatPoint e (setq p (MidPoint e)) ) ) ) ) (setq Obj (MCMText spc (polar p (- Der (/ pi 2.)) (getvar 'TEXTSIZE)) 0. (strcat "%%).Length \\f \"%lu6\">%" ) ) ) (vla-put-rotation Obj (MakeReadable Der)) ) ) (princ))(defun MCMText (block point width string / o) (vla-put-AttachmentPoint (setq o (vla-AddMText block (vlax-3D-point point) width string)) acAttachmentPointMiddleCenter) (vla-put-InsertionPoint o (vlax-3D-point point)) o)(defun MakeReadable ( a ) (cond ( (and (> a (/ pi 2)) ( a pi) (

[编程交流] 自动编号和长度

发表回复

精选推荐