Jump to content

All Activity

This stream auto-updates

  1. Past hour
  2. I think this will help you: (defun c:pp() (setq ed (entget (car (entsel "select image ")))) (strcat " X= " (rtos (cadr (assoc 10 ed))) " Y= " (rtos (caddr (assoc 10 ed))) " dX= " (rtos (* (cadr (assoc 11 ed)) (cadr (assoc 13 ed)))) " dY= " (rtos (* (caddr (assoc 12 ed)) (caddr (assoc 13 ed))))) )
  3. Today
  4. Try this mod. It should draw both top and bottom... Then you can select what is sufficient and remove what is undesirable... If you want pick with mouse for side - it has the same effect like selecting opposition - it has equal steps for working drawing situation... (defun c:PlPath-t+b ( / *error* PlPath-foo rlw ListClockwise-p AssocOn MR:GetVertices MR:GetBulges _intl prelst suflst _buildlist osm sp spp ep epp ss ss1 ss2 plstart plend plx hpllst rpllst pts+buls ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun *error* ( m ) (if osm (setvar (quote osmode) osm) ) (if m (prompt m) ) (princ) ) (defun PlPath-foo ( opt pl ss / _while a b bb ab lst lstab ii ent pln ret pls bls ptlst ptbulg pttbulg ) (defun _while ( i loop ) (while loop (setq i (1+ i)) (setq pls (_buildlist (setq sp (list (car sp) (cadr sp))) (nth i lst))) (foreach pt pls (setq bls (cons (assocon pt (nth i lstab) (function car) 1e-6) bls)) ) (setq bls (reverse bls)) (if (nth (1+ i) lst) (if (vl-member-if (function (lambda ( x ) (equal (list (car ep) (cadr ep)) x 1e-6))) (if (/= i (atoi (rtos (/ (length lst) 2.0)))) (prelst pls (car (_intl pls (nth (1+ i) lst)))) (if (equal (nth i lst) (last lst)) (last lst) (prelst pls (last (_intl pls (nth (1+ i) lst)))) ) )) (setq sp (list (car ep) (cadr ep)) loop nil) (if (/= i (atoi (rtos (/ (length lst) 2.0)))) (setq sp (car (_intl pls (nth (1+ i) lst)))) (setq sp (last (_intl pls (nth (1+ i) lst)))) ) ) (setq sp (list (car ep) (cadr ep)) loop nil) ) (setq pls (prelst pls sp)) (setq bls (prelst bls (assocon sp (nth i lstab) (function car) 1e-6))) (setq ptlst (append ptlst pls)) (setq ptbulg (append ptbulg bls)) (setq pls nil bls nil) ) (list ptlst ptbulg) ) (while ss (gc) (if (and (= opt 1) (= (cdr (assoc 0 (entget pl))) "POLYLINE")) (progn (setq hpllst (cons pl hpllst)) (vl-cmdf "_.convertpoly" "_l" pl "") (entupd pl) ) ) (if (= opt 1) (if (not (ListClockwise-p (MR:GetVertices pl))) (progn (setq rpllst (cons pl rpllst)) (rlw pl) ) ) (if (ListClockwise-p (MR:GetVertices pl)) (progn (setq rpllst (cons pl rpllst)) (rlw pl) ) ) ) (setq a (MR:GetVertices pl)) (setq b (MR:GetBulges pl)) (if (= opt 1) (if (not (ListClockwise-p a)) (setq a (reverse a) b (reverse (mapcar (function (lambda ( x ) (* (- 1.0) x))) b)) bb (cdr b) b (append bb (list (car b))) ab (mapcar (function (lambda ( x y ) (cons x y))) a b)) (setq ab (mapcar (function (lambda ( x y ) (cons x y))) a b)) ) (if (ListClockwise-p a) (setq a (reverse a) b (reverse (mapcar (function (lambda ( x ) (* (- 1.0) x))) b)) bb (cdr b) b (append bb (list (car b))) ab (mapcar (function (lambda ( x y ) (cons x y))) a b)) (setq ab (mapcar (function (lambda ( x y ) (cons x y))) a b)) ) ) (setq lst (cons a lst) lstab (cons ab lstab)) (setq ss (vl-remove pl ss)) (repeat (setq ii (length ss)) (setq ent (nth (setq ii (1- ii)) ss)) (if (not (vl-catch-all-error-p (vl-catch-all-apply (function safearray-value) (list (vl-catch-all-apply (function variant-value) (list (vla-intersectwith (vlax-ename->vla-object pl) (vlax-ename->vla-object ent) AcExtendNone))))))) (setq pln ent) ) ) (if pln (setq pl pln)) ) (setq lst (reverse lst) lstab (reverse lstab)) (if (and (cdr (reverse lst)) (cdr (reverse lstab))) (setq lst (append lst (cdr (reverse lst))) lstab (append lstab (cdr (reverse lstab)))) ) (setq ret (_while -1 t)) (setq ptlst (car ret)) (setq ptbulg (cadr ret)) (setq ptlst (append ptlst (list (list (car ep) (cadr ep))))) (setq ptbulg (append ptbulg (list (assocon (list (car ep) (cadr ep)) (reverse (apply (function append) (reverse lstab))) (function car) 1e-6)))) (if (vl-some (function (lambda ( x ) (null x))) ptlst) (setq ptlst (vl-remove nil ptlst)) ) (if (vl-some (function (lambda ( x ) (null x))) ptbulg) (setq ptbulg (vl-remove nil ptbulg)) ) (if (vl-some (function (lambda ( x ) (equal (cdr x) nil))) ptbulg) (mapcar (function (lambda ( x ) (if (equal (cdr x) nil) (setq pttbulg (cons 0.0 pttbulg)) (setq pttbulg (cons (cdr x) pttbulg))))) ptbulg) (setq pttbulg (mapcar (function cdr) (reverse ptbulg))) ) (list (setq ptlst (mapcar (function (lambda ( x ) (list (car x) (cadr x)))) ptlst)) (setq pttbulg (reverse pttbulg)) ) ) (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 ) ;; by ElpanovEvgeniy ;; reverse lwpolyline (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE") (progn (foreach a1 e (cond ( (= (car a1) 10) (setq x2 (cons a1 x2)) ) ( (= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)) ) ( (= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)) ) ( (= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)) ) ( (= (car a1) 210) (setq x6 (cons a1 x6)) ) ( t (setq x1 (cons a1 x1)) ) ) ) (entmod (append (reverse x1) (append (apply (function append) (apply (function mapcar) (cons (function list) (list x2 (cdr (reverse (cons (car x3) (reverse x3)))) (cdr (reverse (cons (car x4) (reverse x4)))) (cdr (reverse (cons (car x5) (reverse x5)))) ) ) ) ) x6 ) ) ) (entupd lw) ) ) ) (defun ListClockwise-p ( lst / z vlst ) (vl-catch-all-apply (function minusp) (list (if (not (equal 0.0 (setq z (apply (function +) (mapcar (function (lambda ( u v ) (- (* (car u) (cadr v)) (* (car v) (cadr u))) ) ) (setq vlst (mapcar (function (lambda ( a b ) (mapcar (function -) b a)) ) (mapcar (function (lambda ( x ) (car lst))) lst) (cdr (reverse (cons (car lst) (reverse lst)))) ) ) (cdr (reverse (cons (car vlst) (reverse vlst)))) ) ) ) 1e-6 ) ) z (progn (prompt "\n\nChecked vectors are collinear - unable to determine clockwise-p of list") (exit) ) ) ) ) ) (defun assocon ( searchterm lst func fuzz ) (car (vl-member-if (function (lambda ( pair ) (equal searchterm (apply func (list pair)) fuzz)) ) lst ) ) ) (defun MR:GetVertices ( ent / lst ) (if ent (setq lst (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget ent)))) ) ) (defun MR:GetBulges ( ent / lst ) (if ent (setq lst (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) (entget ent)))) ) ) (defun _intl ( l1 l2 / ll1 ll2 a ls1 ls2 ) (setq ll1 l1 ll2 l2 ) (while (setq a (car ll2)) (while ll1 (if (equal a (car ll1) 1e-8) (setq ls1 (append ls1 (list a)) ll1 (cdr ll1) ) (setq ll1 (cdr ll1)) ) ) (setq ll2 (cdr ll2) ll1 (vl-remove a l1) ) ) (setq ll1 l1 ll2 l2 ) (while (setq a (car ll1)) (while ll2 (if (equal a (car ll2) 1e-8) (setq ls2 (append ls2 (list a)) ll2 (cdr ll2) ) (setq ll2 (cdr ll2)) ) ) (setq ll1 (cdr ll1) ll2 (vl-remove a l2) ) ) (if (< (length ls1) (length ls2)) ls1 ls2) ) (defun prelst ( lst el / f ) (vl-remove-if (function (lambda ( a ) (or f (setq f (equal a el 1e-8))))) lst) ) (defun suflst ( lst el ) (cdr (vl-member-if (function (lambda ( a ) (equal a el 1e-8))) lst)) ) (defun _buildlist ( sp lst ) (append (list sp) (suflst lst sp) (prelst lst sp)) ) (setq osm (getvar (quote osmode))) (setvar (quote osmode) 1) (setq sp (getpoint "\nSelect Start Point : ")) (setq ep (getpoint sp "\nSelect End Point : ")) (setq ss (ssget (list (cons 0 "*POLYLINE") (cons -4 "<or") (cons 70 0) (cons 70 1) (cons 70 128) (cons 70 129) (cons -4 "or>") (cons 410 (if (= 1 (getvar (quote cvport))) (getvar (quote ctab)) "Model"))))) (setq ss1 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss)))) (setq ss2 ss1) (setq plstart (car (nentselp sp)) plend (car (nentselp ep))) (setq sp (trans sp 1 plstart) ep (trans ep 1 plend)) (setq spp (list (car sp) (cadr sp)) epp (list (car ep) (cadr ep))) (setq pts+buls (PlPath-foo 1 plstart ss1)) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (assoc 38 (setq plx (entget plstart))) (cons 90 (length (car pts+buls))) (cons 70 (if (= 1 (getvar (quote plinegen))) 128 0 ) ) ) (apply (function append) (mapcar (function (lambda ( p b ) (list (cons 10 p) (cons 42 b)))) (car pts+buls) (cadr pts+buls))) (list (assoc 210 plx)) ) ) (setq sp spp ep epp) (setq pts+buls (PlPath-foo 2 plstart ss2)) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (assoc 38 (setq plx (entget plstart))) (cons 90 (length (car pts+buls))) (cons 70 (if (= 1 (getvar (quote plinegen))) 128 0 ) ) ) (apply (function append) (mapcar (function (lambda ( p b ) (list (cons 10 p) (cons 42 b)))) (car pts+buls) (cadr pts+buls))) (list (assoc 210 plx)) ) ) (foreach pl rpllst (rlw pl) ) (foreach pl hpllst (vl-cmdf "_.convertpoly" "_h" pl "") (entupd pl) ) (*error* nil) ) HTH. M.R.
  5. Yesterday
  6. Hello friends, 1) is it possible, through a code, to obtain the 4 coordinates of an image inserted in a drawing within Autocad? ______________ 2) If it were not possible to obtain the coordinates, perhaps the dimensions of the image could be obtained once inserted? Even if it is without scale, the scale does not matter, just obtain the dimensions of both height and width ______________ 3) If it is not possible, maybe you can tell me how to insert a JPG image, and have it inserted with the real dimensions of the file I can extract the dimensions of an image in the following way: ==================================================================================== (setq IMAGEN (car (entsel "\nSelecciona la imagen: "))) (setq IMAGEN-PROP-VLAX (vlax-ename->vla-object IMAGEN)) (setq ANCHO-IMAGEN (vla-get-Width IMAGEN-PROP-VLAX)) ; Obtener ancho en unidades de dibujo (setq ALTURA-IMAGEN (vla-get-Height IMAGEN-PROP-VLAX)) ; Obtener alto en unidades de dibujo ==================================================================================== Those REAL dimensions of the image file, is how a solution could be, to be able to insert the image at that scale of the real dimensions. This in order to be able to have a parameter to be able to know the height and width, and from those known dimensions and having the real dimensions captured in variables, from there, to be able to scale the image with some other Lisp code . Since if we know the point with coordinates, where the image was inserted, (assoc 10) from there, we can know the coordinates of the other 3 corners, based on those distances from the real dimensions of the image. I hope I haven't messed up too much, ha ha ha Thanks in advance !!!
  7. BIGAL

    Autocad 3D planes

    Using vpoint is another way, you can make some lisp short cuts, then save the UCS set can then change to any view you want. (defun c:vp3 () (command "vpoint" "-1,-1,1") ) (if (= look "R")(command-s "-vpoint" "1,0,0")) (if (= look "L")(command-s "-vpoint" "-1,0,0")) (if (= look "F")(command-s "-vpoint" "0,-1,0")) (if (= look "B")(command-s "-vpoint" "0,1,0")) (if (= look "P")(command-s "-vpoint" "0,0,1"))
  8. Does AutoCAD 3D have welding tool that does welding? I couldn’t find any resources online. For Example. I want to put 1/4 in weld around the metal. Do I just draw 1/4 triangles and extrude to get 3D? Thanks
  9. SLW210

    Autocad 3D planes

    You use VIEW command, View Manager dialog box opens, Preset Views (you can use the Ribbon to open View Manager as well). There is also a toolbar, View. I use: Top left of Modelspace and a Viewport, [-][Top][2D Wireframe], click on Top (or whatever is there at the time) for a dropdown for other views. Click on the - and 2D Wireframe for options as well. For not preset views I use Orbit, sometimes the Cube. I often consider writing some code to use the numpad like some 3D programs.
  10. Nickvnlr

    Divide by custom property

    I fixed it. To retrieve a custom property: (setq si (vla-Get-SummaryInfo (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))) (vla-GetCustomByKey si "ROW SPACING" 'RS) ;;get "ROW SPACING" set to variable RS Since RS is already a string the line will look like this: (list (list "Total Risers:" (strcat "%<\\AcExpr (Sum(B3:B" (itoa (setq r (+ (length (car x)) 2))) "))/" RS "\\f \"%lu2%pr0\">%")))
  11. 3dwannab

    Combining LiSP's

    Fixed the X wall and also edited the prompt for the T so it's more explanatory. Like so: WALL-L X fixed.LSP
  12. when i draw on model space for 3D modeling, i have a hard time understanding which side of plane that i am working on? Do you use the view cube on top right or USC coordinate to indicate the plane? sorry i am begginer in 3D autocad. Thanks
  13. Nickvnlr

    Divide by custom property

    I put the ROW COUNT into RS Like so: (setq RS (getvar "ROW SPACING")) And then the rest of the suggested code change. That gives me this error: Error: bad argument type <NIL> ; expected <INTEGER> at [itoa]
  14. Marko_ribar I want to ask a question about Plpath.lsp. Some times I select the option Top but draw the line Bottom. How the code undestand the Top or the Bottom? All my polylines are CCW. The Top / Bottom is not working well. Is better if I had an option to pick the side. (defun c:PlPath ( / rlw AssocOn ListClockwise-p MR:GetVertices MR:GetBulge _intl prelst suflst _Buildlist loop sp ep ss opt i pl hpllst rpllst pll a b bb ab lst lstab Pls Bls PtlSt PtBulg PttBulg ) (vl-load-com) (defun rlw (LW / E X1 X2 X3 X4 X5 X6) ;; by ElpanovEvgeniy ;; reverse lwpolyline (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE") (progn (foreach a1 e (cond ((= (car a1) 10) (setq x2 (cons a1 x2))) ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4))) ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3))) ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5))) ((= (car a1) 210) (setq x6 (cons a1 x6))) (t (setq x1 (cons a1 x1))) ) ) (entmod (append (reverse x1) (append (apply (function append) (apply (function mapcar) (cons 'list (list x2 (cdr (reverse (cons (car x3) (reverse x3)))) (cdr (reverse (cons (car x4) (reverse x4)))) (cdr (reverse (cons (car x5) (reverse x5)))) ) ) ) ) x6 ) ) ) (entupd lw) ) ) ) (defun AssocOn ( SearchTerm Lst func fuzz ) (car (vl-member-if (function (lambda (pair) (equal SearchTerm (apply func (list pair)) fuzz)) ) lst ) ) ) (defun ListClockwise-p ( lst / z vlst ) (vl-catch-all-apply 'minusp (list (if (not (equal 0.0 (setq z (apply '+ (mapcar (function (lambda (u v) (- (* (car u) (cadr v)) (* (car v) (cadr u))) ) ) (setq vlst (mapcar (function (lambda (a b) (mapcar '- b a)) ) (mapcar (function (lambda (x) (car lst))) lst) (cdr (reverse (cons (car lst) (reverse lst)))) ) ) (cdr (reverse (cons (car vlst) (reverse vlst)))) ) ) ) 1e-6 ) ) z (progn (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list") nil ) ) ) ) ) (defun MR:GetVertices ( e / l ) (if e (setq l (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) (entget e)))) ) ) (defun MR:GetBulge ( e / l ) (if e (setq l (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 42)) (entget e)))) ) ) (defun _intl (l1 l2 / ll1 ll2 a ls1 ls2) (setq ll1 l1 ll2 l2 ) (while (setq a (car ll2)) (while ll1 (if (equal a (car ll1) 1e-6) (setq ls1 (append ls1 (list a)) ll1 (cdr ll1) ) (setq ll1 (cdr ll1)) ) ) (setq ll2 (cdr ll2) ll1 (vl-remove a l1) ) ) (setq ll1 l1 ll2 l2 ) (while (setq a (car ll1)) (while ll2 (if (equal a (car ll2) 1e-6) (setq ls2 (append ls2 (list a)) ll2 (cdr ll2) ) (setq ll2 (cdr ll2)) ) ) (setq ll1 (cdr ll1) ll2 (vl-remove a l2) ) ) (if (< (length ls1) (length ls2)) ls1 ls2) ) (defun prelst ( lst el / f ) (vl-remove-if '(lambda ( a ) (or f (setq f (equal a el 1e-6)))) lst) ) (defun suflst ( lst el ) (cdr (vl-member-if '(lambda ( a ) (equal a el 1e-6)) lst)) ) (defun _Buildlist ( sp lst ) (append (list sp) (suflst lst sp) (prelst lst sp)) ) (setq sp (getpoint "\nSelect Start Point:")) (setq ep (getpoint sp "\nSelect End Point:")) (setq ss (ssget (list '(0 . "*POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 . 128) '(70 . 129) '(-4 . "or>") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))))) (progn (initget 1 "T B") (setq opt (getkword "\nSelect option [Top/Bottom]: ")) ) (setq pl (car (nentselp sp))) (setq sp (trans sp 1 pl) ep (trans ep 1 pl)) (while (>= (sslength ss) 1) (if (eq (cdr (assoc 0 (entget pl))) "POLYLINE") (progn (setq hpllst (cons pl hpllst)) (command "_.convertpoly" "l" pl "") (entupd pl) ) ) (if (eq opt "T") (if (not (ListClockwise-p (MR:GetVertices pl))) (progn (setq rpllst (cons pl rpllst)) (rlw pl) ) ) (if (ListClockwise-p (MR:GetVertices pl)) (progn (setq rpllst (cons pl rpllst)) (rlw pl) ) ) ) (setq a (MR:GetVertices pl)) (setq b (MR:GetBulge pl)) (if (eq opt "T") (if (ListClockwise-p a) (setq ab (mapcar '(lambda (x y) (cons x y)) a b)) (setq a (reverse a) b (reverse (mapcar '(lambda (x) (* (- 1.0) x)) b)) bb (cdr b) b (append bb (list (car b))) ab (mapcar '(lambda (x y) (cons x y)) a b)) ) (if (ListClockwise-p a) (setq a (reverse a) b (reverse (mapcar '(lambda (x) (* (- 1.0) x)) b)) bb (cdr b) b (append bb (list (car b))) ab (mapcar '(lambda (x y) (cons x y)) a b)) (setq ab (mapcar '(lambda (x y) (cons x y)) a b)) ) ) (setq lst (cons a lst) lstab (cons ab lstab)) (ssdel pl ss) (repeat (setq i (sslength ss)) (setq ent (ssname ss (setq i (1- i)))) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vla-intersectwith (vlax-ename->vla-object pl) (vlax-ename->vla-object ent) AcExtendNone))))))) (setq pll ent) ) ) (if pll (setq pl pll)) ) (setq i -1 loop t) (setq lst (reverse lst) lstab (reverse lstab)) (if (and (cdr (reverse lst)) (cdr (reverse lstab))) (setq lst (append lst (cdr (reverse lst))) lstab (append lstab (cdr (reverse lstab)))) ) (while loop (setq i (1+ i)) (setq Pls (_Buildlist (setq sp (list (car sp) (cadr sp))) (nth i lst))) (foreach pt Pls (setq Bls (cons (assocon pt (nth i lstab) 'car 1e-6) Bls)) ) (setq Bls (reverse Bls)) (if (nth (1+ i) lst) (if (vl-member-if '(lambda (x) (equal (list (car ep) (cadr ep)) x 1e-6)) (if (/= i (atoi (rtos (/ (length lst) 2.0)))) (prelst Pls (car (_intl Pls (nth (1+ i) lst)))) (if (equal (nth i lst) (last lst)) (last lst) (prelst Pls (last (_intl Pls (nth (1+ i) lst))))))) (setq sp (list (car ep) (cadr ep)) loop nil) (if (/= i (atoi (rtos (/ (length lst) 2.0)))) (setq sp (car (_intl Pls (nth (1+ i) lst)))) (setq sp (last (_intl Pls (nth (1+ i) lst))))) ) (setq sp (list (car ep) (cadr ep)) loop nil) ) (setq Pls (prelst Pls sp)) (setq Bls (prelst Bls (assocon sp (nth i lstab) 'car 1e-6))) (setq PtlSt (append PtlSt Pls)) (setq PtBulg (append PtBulg Bls)) (setq Bls nil) ) (setq PtlSt (append PtlSt (list (list (car ep) (cadr ep))))) (setq PtBulg (append PtBulg (list (assocon (list (car ep) (cadr ep)) (reverse (apply 'append (reverse lstab))) 'car 1e-6)))) (mapcar '(lambda (x) (if (equal (cdr x) nil) (setq PttBulg (cons 0.0 PttBulg)) (setq PttBulg (cons (cdr x) PttBulg)))) PtBulg) (setq PttBulg (reverse PttBulg)) (setq PtlSt (mapcar '(lambda (x) (list (car x) (cadr x))) PtlSt)) (foreach pl rpllst (rlw pl) ) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (assoc 38 (entget pl)) (cons 90 (length PtlSt)) (cons 70 (if (eq 1 (getvar 'plinegen)) 128 0 ) ) ) (apply 'append (mapcar (function (lambda ( p b ) (list (cons 10 p) (cons 42 b)))) PtlSt PttBulg)) (list (assoc 210 (entget pl))) ) ) (foreach pl hpllst (command "_.convertpoly" "h" pl "") ) (sssetfirst nil (ssadd (entlast))) (princ) ) Thanks
  15. Thanks marko_ribar , I didn't know about this code !!! is nice Thanks
  16. fuccaro

    Divide by custom property

    Put the value of ROW SPACING in the variable RS, and run this code: (list (list "Total Risers:" (strcat "%<\\AcExpr (Sum(B3:B" (itoa (setq r (+ (length (car x)) 2))) (strcat "))/" (itoa RS) " \\f \"%lu2%pr0\">%") ) ) ) It should work...
  17. Have you tried Plpath.lsp from here : https://www.cadtutor.net/forum/topic/37726-draw-polyline-along-with-2-or-more-adjacent-closed-polylines/?do=findComment&comment=442693 I think that it have option top or bottom - 2 sides, but it's not working with 3rd point... So you'll have to try and retry if it's wrong way...
  18. Is it possible to add a Specify 3nd Point to select the correct side to draw the polyline? Thanks
  19. Hi, I am trying to convert this code. This code ask to select two points of a polyline and draw a polyline on the path of the previous polyline to connect them. The problem is that this code connect the two points the most of the time, not from the side I want. I want to add somehow an option , for example Pick from the side you want to create the Polyline. Can any one help? ;PLP - Copying part of LWPolyline ;Lay y tuong tu https://www.cadtutor.net/forum/topic/77002-coping-part-of-polyline/#comment-614215 ;Copy from Lee-Mac http://lee-mac.com/offsetpolysection.html ;;------------------=={ Offset LWPolyline Section }==-------------------;; ;; ;; ;; This program prompts the user to specify an offset distance and to ;; ;; select an LWPolyline. The user is then prompted to specify two ;; ;; points on the LWPolyline enclosing the section to be offset. The ;; ;; progam will proceed to offset all segments between the two given ;; ;; points to both sides by the specified distance. ;; ;; ;; ;; The program is compatible with LWPolylines of constant or varying ;; ;; width, with straight and/or arc segments, and defined in any UCS ;; ;; construction plane. ;; ;;----------------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;; ;;----------------------------------------------------------------------;; ;; Version 1.0 - 27-12-2012 ;; ;; ;; ;; First release. ;; ;;----------------------------------------------------------------------;; ;; Version 1.1 - 05-04-2013 ;; ;; ;; ;; Fixed bug when offsetting polyline arc segments. ;; ;;----------------------------------------------------------------------;; (defun c:PLP ( / d e h l m n o p q w x z elast tt) (vl-load-com) ;; Check if the layer exists, if not, create it (if (not (tblsearch "LAYER" "Poly")) (command "_layer" "_m" "Poly" "_c" "10" "" "_lw" "0.70" "" "plot" "no" "" "") ) ;Sub-Function---------------------------------------------------------------------- ;; Tangent - Lee Mac ;; Args: x - real (defun tan ( x ) (if (not (equal 0.0 (cos x) 1e-8)) (/ (sin x) (cos x)) ) ) ;; LW Vertices - Lee Mac ;; Returns a list of lists in which each sublist describes the position, ;; starting width, ending width and bulge of a vertex of an LWPolyline (defun LM:LWVertices ( e ) (if (setq e (member (assoc 10 e) e)) (cons (list (assoc 10 e) (assoc 40 e) (assoc 41 e) (assoc 42 e) ) (LM:LWVertices (cdr e)) ) ) ) ;Sub-Function---------------------------------------------------------------------- ;Main-Function--------------------------------------------------------------------- (setq PLP-Type (if (and PLP-Type (= (type PLP-Type) 'STR) (or (= PLP-Type "Entsel") (= PLP-Type "NEntsel"))) PLP-Type "Entsel")) (setq d 1 elast (entlast) tt T) (while tt (setvar 'errno 0) (initget "Entsel NEntsel") (if (= PLP-Type "Entsel") (setq e (entsel (strcat "\nEntsel. Copying part of LWPolyline. Select LWPolyline [Entsel/NEntsel]: "))) (setq e (nentsel (strcat "\nNEntsel. Copying part of LWPolyline. Select LWPolyline [Entsel/NEntsel]: ")))) (if e (progn (if (= e "Entsel")(setq PLP-Type "Entsel")) (if (= e "NEntsel")(setq PLP-Type "NEntsel")) (if (and (= (type e) 'LIST) (= (type (car e)) 'ENAME)) (progn (setq e (car e)) (sssetfirst (ssadd e (ssadd))(ssadd e (ssadd))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null e) nil) ( (/= "LWPOLYLINE" (cdr (assoc 0 (entget e)))) (princ (strcat "\nObject " (cdr (assoc 0 (entget e))) " is not a LWPolyline.")) ) ( (setq p (getpoint "\nSpecify 1st Point: ")) (setq p (vlax-curve-getclosestpointto e (trans p 1 0))) (while (and (setq q (getpoint (trans p 0 1) "\nSpecify 2nd Point: ")) (equal p (setq q (vlax-curve-getclosestpointto e (trans q 1 0))) 1e-8) ) (princ "\nPoints must be distinct.") ) (if q (progn (if (> (setq m (vlax-curve-getparamatpoint e p)) (setq n (vlax-curve-getparamatpoint e q)) ) (mapcar 'set '(m n p q) (list n m q p)) ) (setq e (entget e) h (reverse (member (assoc 39 e) (reverse e))) h (subst (cons 70 (logand (cdr (assoc 70 h)) (~ 1))) (assoc 70 h) h) l (LM:LWVertices e) z (assoc 210 e) ) (repeat (fix m) (setq l (cdr l)) ) (if (not (equal m (fix m) 1e-8)) (setq x (car l) w (cdr (assoc 40 x)) l (cons (list (cons 10 (trans p 0 (cdr z))) (cons 40 (+ w (* (- m (fix m)) (- (cdr (assoc 41 x)) w)))) (assoc 41 x) (cons 42 (tan (* (- (min n (1+ (fix m))) m) (atan (cdr (assoc 42 x))) ) ) ) ) (cdr l) ) ) ) (setq l (reverse l)) (repeat (+ (length l) (fix m) (- (fix n)) -1) (setq l (cdr l)) ) (if (not (equal n (fix n) 1e-8)) (setq x (car l) w (cdr (assoc 40 x)) l (vl-list* (list (cons 10 (trans q 0 (cdr z))) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) ) (list (assoc 10 x) (assoc 40 x) (cons 41 (+ w (* (/ (- n (max m (fix n))) (- (1+ (fix n)) (max m (fix n)))) (- (cdr (assoc 41 x)) w) ) ) ) (cons 42 (tan (* (if (< (fix n) m) 1.0 (- n (fix n))) (atan (cdr (assoc 42 x))) ) ) ) ) (cdr l) ) ) ) ;; After creating the polyline (setq o (vlax-ename->vla-object (entmakex (append h (apply 'append (reverse l)) (list z))) ) ;; Set the layer of the polyline to "Poly" ) (vla-put-Layer o "Poly") ;(vl-catch-all-apply 'vla-offset (list o d)) ;(vl-catch-all-apply 'vla-offset (list o (- d))) ;(vla-delete o) ) ) ) );cond );progn );if );progn (setq tt nil));if (if (> (sslength (ssadd (entlast)(ssadd elast (ssadd)))) 1);created new pline (progn (sssetfirst (ssadd (entlast)(ssadd))(ssadd (entlast)(ssadd))) (setq tt nil))) );while (princ) );defun ;;----------------------------------------------------------------------;; ;; End of File ;; ;;----------------------------------------------------------------------;; Thanks
  20. Last week
  21. BIGAL

    Code for labeling swales

    I am not sure but have a sneaky feeling can add a point to a surface using the correct civ3d command via lisp. You can find the command in the CUI. Over the years there is sample code supplied with CIV3D I am not sure if add a point is there, definitely use lisp to make a surface is there. Look in Something like this there is a VL api. Lastly if you search down the CIVIL 3D 2014 directory you will find a example of how to create a TIN via a program, I will see if I can find it, something like Civil 3D API. I may have seen last in CIV3d2012. Search for c:\Autodesk\Autocad Civil3d 2014\sample\civil 3d api\com\vba\SurfaceoperationSample.dvb PS have Point label style changer.lsp for second step. Doing some more digging Check post by Hippe13 I think is answer. I have a dcl select surface even if not displayed. You may also be interested in this for CIV3D surface display uses a toolbar approach the way it should work .Chcontourstoolbar.zip
  22. A couple of different ways find the "-" using (vl-position then look at each character after it should be a "M" Then a "0 1 2 3 4 5 6 7 8 9" then check next if its also "0 1 2 3 4 5 6 7 8 9" Try this (setq str "NEN1555-M06x040E") (setq pos (+ 2 (vl-string-position 45 str))) (setq char1 (strcase (substr str pos 1))) (if (/= char1 "M") (princ "\nThe text chosen does not have a M bolt ") (progn (setq char2 (substr str (+ 1 pos) 1)) (if (or (< (ascii char2) 58)(> (ascii char2) 47)) (setq str2 (strcat char1 char2)) ) (setq char2 (substr str (+ 2 pos) 1)) (if (or (< (ascii char2) 58)(> (ascii char2) 47)) (setq str2 (strcat str2 char2)) ) ) ) ; "M06"
  23. This is the code you can add the "Lxxx" fillet reactor.lsp
  24. John Uhden responded Anyway, StripMtext was the invention of Joe Burke and Steve Doman. My contribution was very small and used only for the earliest releases.
  25. I have this line of code and for the life of me I cannot figure out how to divide by a custom drawing property called "ROW SPACING". ...other stuff (list (list "Total Risers:" (strcat "%<\\AcExpr (Sum(B3:B" (itoa (setq r (+ (length (car x)) 2))) "))/12 \\f \"%lu2%pr0\">%"))) ;;replace 12 with the drawing property "ROW SPACING" ...other stuff How would I do that? Thank you!
  26. CyberAngel

    Code for labeling swales

    Okay, I've spent part of the last week looking at Dynamo again. Apparently, the people who seriously use this package could fit into a monorail car. Autodesk created a package called Toolkit, which has a lot of handy, um, tools. A user created an entire GitHub package for Dynamo and Civil 3D called Camber. There is a node in Camber to create a surface elevation label, which solves half my problem. What's a node, you wonder? Dynamo is visual programming, so instead of functions or methods, you have nodes. (You find nodes in Blender as well.) Here's a sample: The goal is to process from left to right. The wires (tubes) transfer output from one node to input for another node. The two big nodes on the right, with all the wires running into them, are supposed to create surface elevation labels. They need a surface, a label style, and a marker style, which are picked from lists. Then you pick points and pass them both to the label nodes. There are a lot of crossed wires, but that's because I have several inputs going to multiple outputs. The top box on the right creates a 3D polyline between the two picked points and adds it to the drawing. (The Watch box just shows me the polyline when it's done--or it's supposed to. This thing doesn't quite work yet.) Once you catch on, this is definitely easier than code. You can't pass one type of output into a different type of input, so it automatically does type checking. You can see the structure of your algorithm. You don't have to worry about importing libraries. The downsides are that you have to change the way you think about getting things done, and sometimes you have to spend more time setting things up than solving the actual problem.
  27. Clint

    Flip text - lisp

    For some reason, the generous code submission has not effect on the TEXT or MTEXT in a file with the MIRRTEXT setting both as 1 or 0 (zero). I renamed Test to Fliptxt.lsp that appears to be run successfully.
  28. hello everyone, what I would like to program in lisp is the following: in the drawing I have a block (bolt) of which I want to use the name to enter another block (nut). I test for insert 0 and test for the name of the block. Because there are many lengths of, for example, an M8 bolt, the name of the block must be filtered, otherwise the correct block (nut) will not be automatically selected and placed in the drawing. see attached lisp file, with comments. (DEFUN c:nutinsert (/ A B D ) (PROGN (SETQ A (ENTSEL "\nSelect Block: ")) (IF A (PROGN ; (SETQ B (CDR (ASSOC 0 (ENTGET (CAR A))))) (IF (NOT (= B "INSERT")) (ALERT "\nselectinset is not a Block.") ) (IF (= B "INSERT") (PROGN (SETQ D (CDR (ASSOC 2 (ENTGET (CAR A))))) ;get blockname ;following are examples of bolt names, the list is much longer. I only need (IF (OR (= D "NEN1555-M08x070E") ;M8 (OR (= D "NEN1555-M06x040E")) ;M6 (OR (= D "NEN1555-M10x090E")) ;M10 (OR (= D "NEN1555-M16x100E")) ;M16 (OR (= D "NEN1568-M03x050E")) ;M3 (OR (= D "NEN1568-M08x120E")) ;M8 (OR (= D "NEN1568-M06x060E")) ;M6 (= D "NEN1555-M12x050E")) ;M12 ;I need a filter only M8 OR M6 OR M10 ECT, of the blockname. (PROGN (Setvar "Cmdecho" 0) (SETQ OLDLAYER (GETVAR "CLAYER")) (SETQ LAY (IF (NOT (TBLSEARCH "LAYER" "03_GEOMETRIE_050")) (COMMAND "LAYER" "M" "03_GEOMETRIE_050" "C" "7" "" "L" "CONTINUOUS" "" "")) ) (COMMAND "LAYER" "S" "03_GEOMETRIE_050" "") (SETQ Y (getpoint "\nGeef Invoegpunt : ")) (Command "-Insert" "NEN1560-M008-E";the BLOCK name is based on M8. ;it has to be flexible, M3 M4 M5 M6 M8 M10 ECT. Y "" "" Pause) (SETVAR "CLAYER" OLDLAYER) (PRINC) ) ) ) ) ) ) ) ) (PRINC)
  1. Load more activity
×
×
  • Create New...