Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/10/2023 in all areas

  1. You ROCK!! That is one awesome routine!! (It doesn't like if you pick/select sometimes but works great otherwise!) Thank you so very much!! This will get some use!!
    1 point
  2. Your modified code will work enough that I could get by with it... I appreciate it VERY much!! But better code is better code
    1 point
  3. The routine above "works" partially Original text objects (the text is TEXT not MTEXT After the routine After dragging the end of the leader out The leader start point moves. In my testing, the value of the text is very often changed to a previously selected text string too.. I changed the first line (defun c:L2ml ( / ss acount MyEnt GetEnt EntType MyText Knee LineAngle) and got this result (IF) I selected the objects one at a time L to R A selection window gets me this result When I drag that leader out I get this result Changing the first line to this (defun c:L2ml () e If I convert the TEXT to MTEXT first then select one at a time I get the best result If I change these lines (defun c:L2ml ( / ss acount MyEnt GetEnt EntType MyText Knee LineAngle) ((= EntType "TEXT") and select one at a time I get this result
    1 point
  4. @RepCad I have this for the definition points of LINE,MLINE,POLYLINE,POINT,ARC,CIRCLE,ELLIPSE or INSERT. If some placements are incorrect it is easy to redirect them with the grips (vl-load-com) (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst)) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (defun make_lead (pt / obj ptlst arr nw_obj) (setq obj (entlast) ptlst (append pt (polar pt o_lead d_lead)) arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1))) ) (vlax-safearray-fill arr ptlst) (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0)) (vla-put-contenttype nw_obj acMTextContent) (vla-put-textstring nw_obj (strcat "\\fArial|b0|i0|c0|p34;X = " (rtos (car pt) 2 3) "\\PY = " (rtos (cadr pt) 2 3))) (vla-put-layer nw_obj "Id-XY") (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5)) (vla-put-DoglegLength nw_obj (getvar "TEXTSIZE")) (vla-put-LandingGap nw_obj (getvar "TEXTSIZE")) (vla-put-TextHeight nw_obj (getvar "TEXTSIZE")) (if (> (car (getvar "VIEWCTR")) (car pt_lead)) (progn (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0))) (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight) (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr)) ) (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft) ) ) (defun c:ptdef-xy2lead ( / js htx rtx rtx0 pt_lead d_lead o_lead AcDoc Space dxf_cod n lremov ent ename l_pt l_pr) (princ "\nSelect an object for filtering model: ") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "LINE,MLINE,*POLYLINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nIsn't an availaible object for this function!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive field height <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nGive field orientation <0.0>: "))) (setq rtx 0.0)) (setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx)) (initget 1) (setq pt_lead (getpoint (getvar "VIEWCTR") "\nGive general orientation and distance for guide: ")) (setq d_lead (distance (getvar "VIEWCTR") pt_lead)) (setq o_lead (angle (getvar "VIEWCTR") pt_lead)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (cond ((null (tblsearch "LAYER" "Id-XY")) (vlax-put (vla-add (vla-get-layers AcDoc) "Id-XY") 'color 174) ) ) (setq dxf_cod (entget (ssname js 0))) (initget "Single Multiple") (if (eq (getkword "\nSelection filtering [Single/Multiple]<M>: ") "Single") (setq n -1) (setq dxf_cod (entget (ssname js 0)) js (ssget "_X" (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) ) n -1 ) ) (repeat (sslength js) (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))) l_pt nil) (setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints)) (foreach n l_pr (if (vlax-property-available-p ename n) (setq l_pt (if (eq n 'Coordinates) (progn (append (if (eq (vla-get-ObjectName ename) "AcDbPolyline") (l-coor2l-pt (vlax-get ename n) nil) (l-coor2l-pt (vlax-get ename n) T) ) l_pt ) ) (cons (vlax-get ename n) l_pt) ) ) ) ) (mapcar 'make_lead l_pt) ) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) (prin1) )
    1 point
  5. @mhupp. ok, naturally offset is going outside. Instead checking for CCW or CW , it is easy to check if the new offset poly has a bigger area than the original, then it is outside
    1 point
  6. @devitg that lisp has two short comings like bigal said you need to check the CW or CCW of the polyline because depending on that if the polyline is offset in or out the VLAX-CURVE-GETCLOSESTPOINTTO will find a different point. it will be on the polyline but not the vertex XY cords. using the vl-sort with lambda searches the already found points of the polyline and picks the closest one to the offset point. (still not 100% but pretty close) see my drawing blue is below points white is your lisp. it was offset to the inside (DEFUN C:PCL (/ A ADOC MODEL PL L OFF OFF-PL-L PL PL-OBJ TEXTSIZE TXT pts ) (VL-LOAD-COM) (setq ADOC (vla-get-ActiveDocument (vlax-get-Acad-Object))) (setq mspace (vla-get-modelspace ADOC)) (setq PL (car (entsel "\nSelect Polyline to label its vertices: "))) (setq PL-OBJ (vlax-ename->vla-object PL)) (setq L (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget PL)))) (setq TEXTSIZE (getvar 'TEXTSIZE)) (setq off (vlax-invoke PL-OBJ 'offset (if (CW PL-OBJ) (* -2 TEXTSIZE) (* 2 TEXTSIZE)))) ;offset to outside (setq OFF-PL-L (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (vlax-vla-object->ename (car off)))))) (vla-delete (car off)) (foreach pt OFF-PL-L (setq A (car (vl-sort L (function (lambda ( a b ) (< (distance pt a) (distance pt b))))))) ;finds cloest point of polyline to pt (setq txt (strcat "X:" (rtos (car A) 2 3) "\\P" "Y:" (rtos (cadr A) 2 3))) (COMMAND "_.leader" "_non" A pt "" txt "") ) ;end FOREACH ) ;END LEADER-VERTX ;;----------------------------------------------------------------------------;; ; Checking if pline drawn CW or CCW - Writer Evgeniy Elpanov By Bill Gilliss (defun CW (poly / lw lst LL UR) (if (= poly vla-item) (setq lw poly) (setq lw (vlax-ename->vla-object poly)) ) (vla-GetBoundingBox lw 'LL 'UR) (setq LL (vlax-safearray->list LL) UR (vlax-safearray->list UR) lst (mapcar (function (lambda (x) (vlax-curve-getParamAtPoint poly (vlax-curve-getClosestPointTo poly x) ) ) ) (list LL (list (car LL) (cadr UR)) UR (list (car UR) (cadr LL)) ) ) ) (if (or (<= (car lst) (cadr lst) (caddr lst) (cadddr lst)) (<= (cadr lst) (caddr lst) (cadddr lst) (car lst)) (<= (caddr lst) (cadddr lst) (car lst) (cadr lst)) (<= (cadddr lst) (car lst) (cadr lst) (caddr lst)) ) ;_ or t ) ) points.dxf
    1 point
  7. @RepCad @BIGAL, how to let ACAD to work by himself? It is what it is for was made. leader @ vertex.lsp new - Leader.dwg
    1 point
  8. If its a pline then the leader angle can be considered as the 1/2 difference of angle between vertices 1-2-3, 2-3-4, 3-4 -1, 4-1-2. The other thing is need to check is pline CW CCW. Controls wether it goes in or out. The other check is which quadrant is leader in, so text goes out also.
    1 point
  9. The following should handle any layout naming convention, either retaining or ignoring leading zeroes: (defun c:copylayout ( / cmd lyt new ) (cond ( (= 1 (getvar 'tilemode)) (princ "\nCommand only available in paperspace.") ) ( (setq cmd (getvar 'cmdecho) lyt (getvar 'ctab) new lyt ) (setvar 'cmdecho 0) (repeat (progn (initget 6) (cond ((getint "\nNumber of layouts to create <1>: ")) (1)) ) (while (member (setq new (LM:suffix++ new)) (layoutlist))) (vl-cmdf "_.-layout" "_c" lyt new) (setq lyt new) ) (setvar 'cmdecho cmd) ) ) (princ) ) (defun LM:suffix++ ( str ) (cond ( (wcmatch str "~*#") (strcat str "1") ) ( (wcmatch str "*9") (strcat (LM:suffix++ (substr str 1 (1- (strlen str)))) "0") ) ( (strcat (substr str 1 (1- (strlen str))) (chr (1+ (ascii (substr str (strlen str))))) ) ) ) ) (princ) I don't think LT fully supports VL/ActiveX, and so the automatic layout ordering may not be possible, but on the off-chance that it does, give this a try: (defun c:sortlayouts ( / lst ord tab ) (vlax-for lyt (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (if (= :vlax-false (vla-get-modeltype lyt)) (setq lst (cons lyt lst) ord (cons (strcase (vla-get-name lyt)) ord) ) ) ) (setq tab 1) (foreach idx (vl-sort-i ord 'compare) (vla-put-taborder (nth idx lst) tab) (setq tab (1+ tab)) ) (princ) ) (defun compare ( a b / x y ) (setq x (ascii a) y (ascii b) ) (cond ( (zerop x)) ( (zerop y) nil) ( (= x y) (compare (substr a 2) (substr b 2))) ( (and (< 47 x 58) (< 47 y 58)) (< (atof a) (atof b)) ) ( (< x y)) ) ) (vl-load-com) (princ)
    1 point
  10. In combination with this : https://www.theswamp.org/index.php?topic=53697.msg583798#msg583798 , you can make associative hatch and make walls or ways - ground paths remarkable perfect... Thanks for your effort Emmanuel... P.S. You have to be member to access the link I provided...
    1 point
×
×
  • Create New...