block insert lsp

Anonymous · ‎01-27-2020

thank you all guys. I always get a lot of help this site.
I search and found this lsp. but it's a bit different from what I want.
so I modified this a little bit
I want to change it to what I want.

some help

I attached a .dwg file
;=======================================================
(defun c:foo (/ e o s tmp)
(if (and (setq e (car (entsel "\nSelect a block to copy: ")))
   (vlax-write-enabled-p (setq o (vlax-ename->vla-object e)))
   (vlax-property-available-p o 'insertionpoint)
   (setq s (ssget '((0 . "line"))))
     )
   (foreach l (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
     (mapcar '(lambda (x)
(and (not (vl-position x tmp))
       (setq tmp (cons x tmp))
       (setq o (vla-copy o))
       (vlax-put o 'insertionpoint x)
)
       )
      (list (vlax-curve-getstartpoint l) (vlax-curve-getendpoint l))
     )
   )
)
(princ)
)
(vl-load-com)

devitg · ‎01-27-2020

Try it

(DEFUN INS-BLK  ()
  (SETQ LINE (SSNAME (SSGET "_:S+." '((0 . "line"))) 0))

  (SETQ LINE-10 (CDR (ASSOC 10 (ENTGET LINE))))
  (SETQ LINE-11 (CDR (ASSOC 11 (ENTGET LINE))))

  (SETQ LINE-10-X (CAR LINE-10))
  (SETQ LINE-11-X (CAR LINE-11))
  (SETQ LINE-10-Y (CADR LINE-10))
  (SETQ LINE-11-Y (CADR LINE-11))
;;;14.1531 
;;;32.1201 
;;;-9.6773 
;;;-9.6773 

  


  (COND
    ((< LINE-10-X LINE-11-X)
     (PROGN (VL-CMDF "._-insert" "1" LINE-10 1 1 1 0) (VL-CMDF "._-insert" "2" LINE-11 1 1 1 0)))
    ((> LINE-10-X LINE-11-X)
     (PROGN (VL-CMDF "._-insert" "2" LINE-11 1 1 1 0) (VL-CMDF "._-insert" "1" LINE-10 1 1 1 0)))
    ((< LINE-10-Y LINE-11-Y)
     (PROGN (VL-CMDF "._-insert" "3" LINE-10 1 1 1 0) (VL-CMDF "._-insert" "4" LINE-11 1 1 1 0)))
    ((> LINE-10-y LINE-11-y)
     (PROGN (VL-CMDF "._-insert" "4" LINE-11 1 1 1 0) (VL-CMDF "._-insert" "3" LINE-10 1 1 1 0)))
    (T (ALERT "what hapen "))
    )
)

Sea-Haven · ‎01-27-2020

Try this only need one block as it uses line angle, block is mm units is Meters have allowed for this.

(defun c:blk2end ( / oldaunits e inspt name xsc ysc stpt endpt  ang)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(setvar 'insunits 4)
(setq oldinsunits (getvar 'insunits))
(setq e (entget (car (entsel "\nSelect a block to copy: "))))
(if  (= (cdr (assoc 0 e)) "INSERT")
(progn
(setq inspt (cdr (assoc 10 e)))
(setq name (cdr (assoc 2 e)))
(setq xsc (cdr (assoc 41 e)))
(setq ysc (cdr (assoc 42 e)))
(while (setq e (car (entsel "\nSelect a line: Enter to exit ")))
(setq e (entget e))
(if (= (cdr (assoc 0 e)) "LINE")
(progn
(setq stpt (cdr (assoc 10 e)))
(setq endpt (cdr (assoc 11 e)))
(setq ang (angle stpt endpt))
(command "-insert" name stpt xsc ysc ang)
(command "-insert" name endpt xsc ysc (+ ang pi))
)
)
)
)
(alert "You did not pick a block redo ")
)
(setvar 'aunits oldaunits)
(setvar 'insunits oldinsunits)
(princ)
)
(c:blk2end)

Anonymous · ‎01-27-2020

oh that is so good. but

The blocks are inserted at an oblique angle. one more check please...

Anonymous · ‎01-27-2020

thank you so good

Block is not select, I want it by block name.

Sea-Haven · ‎01-27-2020

You only need 1 block if you want it at different angle then can be added.

(defun c:blk2end ( / oldaunits e inspt name xsc ysc stpt endpt  ang)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(setq oldinsunits (getvar 'insunits))
(setvar 'insunits 4)
(setq name (getstring "Enter block name "))
(while (setq e (car (entsel "\nSelect a line: Enter to exit ")))
(setq e (entget e))
(if (= (cdr (assoc 0 e)) "LINE")
(progn
(setq stpt (cdr (assoc 10 e)))
(setq endpt (cdr (assoc 11 e)))
(setq ang (angle stpt endpt))
(command "-insert" name stpt 1 1  ang)
(command "-insert" name endpt 1 1 (+ ang pi))
)
)
)
(setvar 'aunits oldaunits)
(setvar 'insunits oldinsunits)
(princ)
)
(c:blk2end)

Anonymous · ‎01-27-2020

tnank you. I received a lot of help
in addition, I typed that sentence ---> (command "_.pedit" e "" "width" 10 "")

and then lsp does not working. where should I add it???

(defun c:blk2end ( / oldaunits e inspt name xsc ysc stpt endpt ang)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(setq oldinsunits (getvar 'insunits))
(setvar 'insunits 4)
(setq name (getstring "Enter block name "))
(while (setq e (car (entsel "\nSelect a line: Enter to exit ")))
(setq e (entget e))
(if (= (cdr (assoc 0 e)) "LINE")
(progn
(setq stpt (cdr (assoc 10 e)))
(setq endpt (cdr (assoc 11 e)))
(setq ang (angle stpt endpt))
(command "-insert" name stpt 1 1 ang) (command "_.pedit" e "" "width" 10 "")
(command "-insert" name endpt 1 1 (+ ang pi)) (command "_.pedit" e "" "width" 10 "")
)
)
)
(setvar 'aunits oldaunits)
(setvar 'insunits oldinsunits)
(princ)
)
(c:blk2end)

CADaSchtroumpf · ‎01-28-2020

An another way, work's with line or polyligne

(defun c:blk2end ( / js n obj dxf_obj obj_vlax pt1_start pt1_end par pt2_start pt2_end dxf_210)
	(defun z_dir (p1 p2 / )
		(trans
			'(0.0 1.0 0.0)
			(mapcar
				'(lambda (k)
					(/ k
						(sqrt
							(apply '+
								(mapcar
									'(lambda (x) (* x x))
									(mapcar '- p2 p1)
								)
							)
						)
					)
				)
				(mapcar '- p2 p1)
			)
			0
		)
	)
	(if (not (tblsearch "BLOCK" "BLK2END"))
		(foreach n
			'(
				(
					(0 . "BLOCK")
					(8 . "0")
					(2 . "BLK2END")
					(70 . 0)
					(8 . "0")
					(62 . 0)
					(6 . "ByBlock")
					(370 . -2)
					(10 0.0 0.0 0.0)
				)
				(
					(0 . "LWPOLYLINE")
					(100 . "AcDbEntity")
					(67 . 0)
					(410 . "Model")
					(8 . "0")
					(62 . 0)
					(6 . "ByBlock")
					(370 . -2)
					(100 . "AcDbPolyline")
					(90 . 4)
					(70 . 1)
					(43 . 0.0)
					(38 . 0.0)
					(39 . 0.0)
					(10 -0.445911 -0.812606)
					(40 . 0.0)
					(41 . 0.0)
					(42 . 0.0)
					(91 . 0)
					(10 -5.0922 -0.812606)
					(40 . 0.0)
					(41 . 0.0)
					(42 . 0.0)
					(91 . 0)
					(10 -5.0922 0.812606)
					(40 . 0.0)
					(41 . 0.0)
					(42 . 0.0)
					(91 . 0)
					(10 -0.445911 0.812606)
					(40 . 0.0)
					(41 . 0.0)
					(42 . 0.0)
					(91 . 0)
					(210 0.0 0.0 1.0)
				)
				(
					(0 . "LINE")
					(100 . "AcDbEntity")
					(67 . 0)
					(410 . "Model")
					(8 . "0")
					(62 . 0)
					(6 . "ByBlock")
					(370 . -2)
					(100 . "AcDbLine")
					(10 -1.37887 -0.812606 0.0)
					(11 -5.0922 0.812606 0.0)
					(210 0.0 0.0 1.0)
				)
				(
					(0 . "LINE")
					(100 . "AcDbEntity")
					(67 . 0)
					(410 . "Model")
					(8 . "0")
					(62 . 0)
					(6 . "ByBlock")
					(370 . -2)
					(100 . "AcDbLine")
					(10 -5.0922 -0.812606 0.0)
					(11 -1.37887 0.812606 0.0)
					(210 0.0 0.0 1.0)
				)
				(
					(0 . "LINE")
					(100 . "AcDbEntity")
					(67 . 0)
					(410 . "Model")
					(8 . "0")
					(62 . 0)
					(6 . "ByBlock")
					(370 . -2)
					(100 . "AcDbLine")
					(10 -1.37887 -1.21383 0.0)
					(11 -1.37887 1.19977 0.0)
					(210 0.0 0.0 1.0)
				)
				(
					(0 . "LINE")
					(100 . "AcDbEntity")
					(67 . 0)
					(410 . "Model")
					(8 . "0")
					(62 . 0)
					(6 . "ByBlock")
					(370 . -2)
					(100 . "AcDbLine")
					(10 -5.0922 0.0 0.0)
					(11 0.0 0.0 0.0)
					(210 0.0 0.0 1.0)
				)
				(
					(0 . "ENDBLK")
					(8 . "0")
					(62 . 0)
					(6 . "ByBlock")
					(370 . -2)
				)
			)
			(entmake n)
		)
	)
	(princ "\nSelect polylines or lines.") 
	(setq js (ssget '((0 . "*POLYLINE,LINE"))))
	(repeat (setq n (sslength js))
		(setq obj (ssname js (setq n (1- n))))
		(cond
			(
				(or
					(eq (cdr (assoc 0 (setq dxf_obj (entget obj)))) "LWPOLYLINE")
					(eq (cdr (assoc 0 dxf_obj)) "LINE")
					(and
						(eq (cdr (assoc 0 dxf_obj)) "POLYLINE")
						(zerop (boole 1 112 (cdr (assoc 70 dxf_obj))))
					)
				)
				(vl-load-com)
				(setq
					obj_vlax (vlax-ename->vla-object obj)
					pt1_start (vlax-curve-getStartPoint obj_vlax)
					pt1_end (vlax-curve-getEndPoint obj_vlax)
					par (vlax-curve-getParamAtPoint obj_vlax pt1_end)
				)
				(cond
					((not (zerop par))
						(setq
							pt2_start (vlax-curve-getPointAtParam obj_vlax 1)
							pt2_end (vlax-curve-getPointAtParam obj_vlax (1- par))
						)
						(foreach n (list (list pt1_start pt2_start) (list pt1_end pt2_end))
							(setq dxf_210 (z_dir (car n) (cadr n)))
							(entmake
								(list
									(cons 0 "INSERT")
									(cons 100 "AcDbEntity")
									(assoc 67 dxf_obj)
									(assoc 410 dxf_obj)
									(cons 8 (getvar "CLAYER"))
									(cons 100 "AcDbBlockReference")
									(cons 2 "BLK2END")
									(cons 10 (trans (car n) 0 dxf_210))
									(cons 50 (angle (trans (car n) 0 dxf_210) (trans (cadr n) 0 dxf_210)))
									(cons 210 dxf_210)
								)
							)
						)
					)
				)
				(if (eq (cdr (assoc 0 dxf_obj)) "LINE")
					(progn
						(entmake
							(list
								'(0 . "LWPOLYLINE")
								'(100 . "AcDbEntity")
								(assoc 67 dxf_obj)
								(assoc 410 dxf_obj)
								(assoc 8 dxf_obj)
								(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) '(62 . 256))
								(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) '(6 . "Bylayer"))
								(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) '(370 . -1))
								'(100 . "AcDbPolyline")
								'(90 . 2)
								'(70 . 0)
								'(43 . 10.0)
								(cons 38 (caddr pt1_start))
								(if (assoc 39 dxf_obj) (assoc 39 dxf_obj) '(39 . 0.0))
								(cons 10 (list (car pt1_start) (cadr pt1_start)))
								'(40 . 10.0)
								'(41 . 10.0)
								'(42 . 0.0)
								'(91 . 0)
								(cons 10 (list (car pt1_end) (cadr pt1_end)))
								'(40 . 10.0)
								'(41 . 10.0)
								'(42 . 0.0)
								'(91 . 0)
								(assoc 210 dxf_obj)
							)
						)
						(entdel obj)
					)
					(vlax-put obj_vlax 'ConstantWidth 10.0)
				)
			)
			(T
				(princ "\nIsn't 2Dpolyline avalaible for this function!")
			)
		)
	)
	(prin1)
)

devitg · ‎01-28-2020

Please upload such dwg with inclined block position

Kent1Cooper · ‎01-28-2020

@Anonymous wrote:

..... I typed that sentence ---> (command "_.pedit" e "" "width" 10 "")

and then lsp does not working. where should I add it???

....

(while (setq e (car (entsel "\nSelect a line: Enter to exit ")));;<-- e is an entity name
(setq e (entget e));;<-- e is now an entity data list
(if (= (cdr (assoc 0 e)) "LINE")
....
(command "-insert" name stpt 1 1 ang) (command "_.pedit" e "" "width" 10 "");;<-- e needs to be an entity name, not an entity data list
....

The PEDIT command needs an entity, not an entity data list. I suggest you keep the entity name and the entity data as separate variables:

....

(while (setq ent (car (entsel "\nSelect a line: Enter to exit ")));;<-- ent is the entity name
(setq edata (entget e));;<-- edata is the entity data list
(if (= (cdr (assoc 0 edata)) "LINE")
....
(command "-insert" name stpt 1 1 ang) (command "_.pedit" ent "" "width" 10 "");;<-- ent is the entity name
....

Kent Cooper, AIA

Sea-Haven · ‎01-28-2020

Thanks Kent, code updated for pedit.

(defun c:blk2end ( / oldaunits e ent inspt name stpt endpt  ang)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(setq oldinsunits (getvar 'insunits))
(setvar 'insunits 4)
(setq name (getstring "\nEnter block name "))
(while (setq e (car (entsel "\nSelect a line: Enter to exit ")))
(setq ent (entget e))
(if (= (cdr (assoc 0 ent)) "LINE")
(progn
(setq stpt (cdr (assoc 10 ent)))
(setq endpt (cdr (assoc 11 ent)))
(setq ang (angle stpt endpt))
(command "_.pedit" e "Y" "width" 10 "")
(command "-insert" name stpt 1 1  ang)
(command "-insert" name endpt 1 1 (+ ang pi))
)
)
)
(setvar 'aunits oldaunits)
(setvar 'insunits oldinsunits)
(princ)
)
(c:blk2end)

Sea-Haven · ‎01-28-2020

Added plines

; Block to ends of pline or lines
; By Alan Jan 2020   info@Alanh.com.au

(defun alg-ang (obj pnt)
  (angle '(0. 0. 0.)
     (vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
         obj
         pnt
       )
     )
  )
)

(defun c:blk2end ( / oldaunits oldinsunit e obj name start end  ang1 ang2)
(defun ins1 ()
(setq start (vlax-curve-getstartpoint obj))
(setq end (vlax-curve-getendpoint obj))
(setq ang1 (+ (alg-ang obj start) pi))
(setq ang2 (+ (alg-ang obj end) pi))
(vlax-put obj 'ConstantWidth 1.0)
(command "-insert" name start 1 1  ang1)
(command "-insert" name end 1 1 ang2)
)
(defun ins2 ()
(setq end (vlax-get Obj 'EndPoint))
(setq start (vlax-get Obj 'StartPoint))
(setq ang1 (angle start end))
(setq ang2 (angle end start))
(command "_.pedit" e "Y" "width" 1.0 "")
(command "-insert" name start 1 1  ang1)
(command "-insert" name end 1 1 ang2)
)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(setq oldinsunits (getvar 'insunits))
(setvar 'insunits 4)
(setq name (getstring "\nEnter block name "))
(while (setq e (car (entsel "\nSelect a line: Enter to exit ")))
(setq obj (vlax-ename->vla-object e))
(setq objname (vla-get-objectname obj))
(cond
((= objName "AcDbPolyline")(ins1))
((= objName "AcDbLine")(ins2))
((alert "Incorrect object picked"))
)
)
(setvar 'aunits oldaunits)
(setvar 'insunits oldinsunits)
(princ)
)
(c:blk2end)

Anonymous · ‎01-28-2020

thank you everyone.
I got a lot of help for me

Community

block insert lsp

block insert lsp

block insert lsp